xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 8fcddce65efd55a8fe3f87d4c08c15577ce4cbef)
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 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   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);
224   if (pcbddc->n_ISForDofsLocal && field >= 0) {
225     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
226     nedfieldlocal = pcbddc->ISForDofsLocal[field];
227     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
228   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
229     ne            = n;
230     nedfieldlocal = NULL;
231     global        = PETSC_TRUE;
232   } else if (field == PETSC_DECIDE) {
233     PetscInt rst,ren,*idx;
234 
235     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
238     for (i=rst;i<ren;i++) {
239       PetscInt nc;
240 
241       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
242       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
243       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
244     }
245     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
248     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
249     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
250   } else {
251     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
252   }
253 
254   /* Sanity checks */
255   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
256   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
257   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);
258 
259   /* Just set primal dofs and return */
260   if (setprimal) {
261     IS       enedfieldlocal;
262     PetscInt *eidxs;
263 
264     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
265     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
266     if (nedfieldlocal) {
267       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
268       for (i=0,cum=0;i<ne;i++) {
269         if (PetscRealPart(vals[idxs[i]]) > 2.) {
270           eidxs[cum++] = idxs[i];
271         }
272       }
273       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
274     } else {
275       for (i=0,cum=0;i<ne;i++) {
276         if (PetscRealPart(vals[i]) > 2.) {
277           eidxs[cum++] = i;
278         }
279       }
280     }
281     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
282     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
283     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
284     ierr = PetscFree(eidxs);CHKERRQ(ierr);
285     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
286     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
287     PetscFunctionReturn(0);
288   }
289 
290   /* Compute some l2g maps */
291   if (nedfieldlocal) {
292     IS is;
293 
294     /* need to map from the local Nedelec field to local numbering */
295     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
296     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
297     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
298     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
300     if (global) {
301       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
302       el2g = al2g;
303     } else {
304       IS gis;
305 
306       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
307       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
308       ierr = ISDestroy(&gis);CHKERRQ(ierr);
309     }
310     ierr = ISDestroy(&is);CHKERRQ(ierr);
311   } else {
312     /* restore default */
313     pcbddc->nedfield = -1;
314     /* one ref for the destruction of al2g, one for el2g */
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     el2g = al2g;
318     fl2g = NULL;
319   }
320 
321   /* Start communication to drop connections for interior edges (for cc analysis only) */
322   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
323   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
324   if (nedfieldlocal) {
325     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
326     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
327     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
328   } else {
329     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
330   }
331   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333 
334   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
335     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
336     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
337     if (global) {
338       PetscInt rst;
339 
340       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
341       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
342         if (matis->sf_rootdata[i] < 2) {
343           matis->sf_rootdata[cum++] = i + rst;
344         }
345       }
346       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
347       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
348     } else {
349       PetscInt *tbz;
350 
351       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
352       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
355       for (i=0,cum=0;i<ne;i++)
356         if (matis->sf_leafdata[idxs[i]] == 1)
357           tbz[cum++] = i;
358       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
359       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
360       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
361       ierr = PetscFree(tbz);CHKERRQ(ierr);
362     }
363   } else { /* we need the entire G to infer the nullspace */
364     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
365     G    = pcbddc->discretegradient;
366   }
367 
368   /* Extract subdomain relevant rows of G */
369   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
370   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
371   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
372   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISDestroy(&lned);CHKERRQ(ierr);
374   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
375   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
376   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
377 
378   /* SF for nodal dofs communications */
379   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
380   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
381   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
382   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
383   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
384   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
385   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
386   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
387   i    = singular ? 2 : 1;
388   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
389 
390   /* Destroy temporary G created in MATIS format and modified G */
391   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
392   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
393   ierr = MatDestroy(&G);CHKERRQ(ierr);
394 
395   if (print) {
396     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
397     ierr = MatView(lG,NULL);CHKERRQ(ierr);
398   }
399 
400   /* Save lG for values insertion in change of basis */
401   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
402 
403   /* Analyze the edge-nodes connections (duplicate lG) */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
405   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
406   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
410   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
411   /* need to import the boundary specification to ensure the
412      proper detection of coarse edges' endpoints */
413   if (pcbddc->DirichletBoundariesLocal) {
414     IS is;
415 
416     if (fl2g) {
417       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
418     } else {
419       is = pcbddc->DirichletBoundariesLocal;
420     }
421     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
422     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
423     for (i=0;i<cum;i++) {
424       if (idxs[i] >= 0) {
425         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
426         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
427       }
428     }
429     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
430     if (fl2g) {
431       ierr = ISDestroy(&is);CHKERRQ(ierr);
432     }
433   }
434   if (pcbddc->NeumannBoundariesLocal) {
435     IS is;
436 
437     if (fl2g) {
438       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
439     } else {
440       is = pcbddc->NeumannBoundariesLocal;
441     }
442     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
443     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
444     for (i=0;i<cum;i++) {
445       if (idxs[i] >= 0) {
446         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
447       }
448     }
449     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
450     if (fl2g) {
451       ierr = ISDestroy(&is);CHKERRQ(ierr);
452     }
453   }
454 
455   /* Count neighs per dof */
456   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
458 
459   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
460      for proper detection of coarse edges' endpoints */
461   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
462   for (i=0;i<ne;i++) {
463     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
464       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
465     }
466   }
467   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
468   if (!conforming) {
469     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
470     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
471   }
472   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
473   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
474   cum  = 0;
475   for (i=0;i<ne;i++) {
476     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
477     if (!PetscBTLookup(btee,i)) {
478       marks[cum++] = i;
479       continue;
480     }
481     /* set badly connected edge dofs as primal */
482     if (!conforming) {
483       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
484         marks[cum++] = i;
485         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
486         for (j=ii[i];j<ii[i+1];j++) {
487           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
488         }
489       } else {
490         /* every edge dofs should be connected trough a certain number of nodal dofs
491            to other edge dofs belonging to coarse edges
492            - at most 2 endpoints
493            - order-1 interior nodal dofs
494            - no undefined nodal dofs (nconn < order)
495         */
496         PetscInt ends = 0,ints = 0, undef = 0;
497         for (j=ii[i];j<ii[i+1];j++) {
498           PetscInt v = jj[j],k;
499           PetscInt nconn = iit[v+1]-iit[v];
500           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
501           if (nconn > order) ends++;
502           else if (nconn == order) ints++;
503           else undef++;
504         }
505         if (undef || ends > 2 || ints != order -1) {
506           marks[cum++] = i;
507           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
508           for (j=ii[i];j<ii[i+1];j++) {
509             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
510           }
511         }
512       }
513     }
514     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
515     if (!order && ii[i+1] != ii[i]) {
516       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
517       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
518     }
519   }
520   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
521   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
522   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
523   if (!conforming) {
524     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
525     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
526   }
527   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
528 
529   /* identify splitpoints and corner candidates */
530   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
531   if (print) {
532     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
533     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
534     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
535     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
536   }
537   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
538   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
539   for (i=0;i<nv;i++) {
540     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
541     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
542     if (!order) { /* variable order */
543       PetscReal vorder = 0.;
544 
545       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
546       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
547       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
548       ord  = 1;
549     }
550 #if defined(PETSC_USE_DEBUG)
551     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);
552 #endif
553     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
554       if (PetscBTLookup(btbd,jj[j])) {
555         bdir = PETSC_TRUE;
556         break;
557       }
558       if (vc != ecount[jj[j]]) {
559         sneighs = PETSC_FALSE;
560       } else {
561         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
562         for (k=0;k<vc;k++) {
563           if (vn[k] != en[k]) {
564             sneighs = PETSC_FALSE;
565             break;
566           }
567         }
568       }
569     }
570     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
571       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
572       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
573     } else if (test == ord) {
574       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
575         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
576         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
577       } else {
578         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
579         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
580       }
581     }
582   }
583   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
585   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
586 
587   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
588   if (order != 1) {
589     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
590     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
591     for (i=0;i<nv;i++) {
592       if (PetscBTLookup(btvcand,i)) {
593         PetscBool found = PETSC_FALSE;
594         for (j=ii[i];j<ii[i+1] && !found;j++) {
595           PetscInt k,e = jj[j];
596           if (PetscBTLookup(bte,e)) continue;
597           for (k=iit[e];k<iit[e+1];k++) {
598             PetscInt v = jjt[k];
599             if (v != i && PetscBTLookup(btvcand,v)) {
600               found = PETSC_TRUE;
601               break;
602             }
603           }
604         }
605         if (!found) {
606           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
607           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
608         } else {
609           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
610         }
611       }
612     }
613     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
614   }
615   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
616   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
617   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
618 
619   /* Get the local G^T explicitly */
620   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
621   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
622   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
623 
624   /* Mark interior nodal dofs */
625   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
626   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
627   for (i=1;i<n_neigh;i++) {
628     for (j=0;j<n_shared[i];j++) {
629       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
630     }
631   }
632   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
633 
634   /* communicate corners and splitpoints */
635   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
636   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
638   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
639 
640   if (print) {
641     IS tbz;
642 
643     cum = 0;
644     for (i=0;i<nv;i++)
645       if (sfvleaves[i])
646         vmarks[cum++] = i;
647 
648     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
649     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
650     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
651     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
652   }
653 
654   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
655   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
657   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658 
659   /* Zero rows of lGt corresponding to identified corners
660      and interior nodal dofs */
661   cum = 0;
662   for (i=0;i<nv;i++) {
663     if (sfvleaves[i]) {
664       vmarks[cum++] = i;
665       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
666     }
667     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
668   }
669   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
670   if (print) {
671     IS tbz;
672 
673     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
674     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
675     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
676     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
677   }
678   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
679   ierr = PetscFree(vmarks);CHKERRQ(ierr);
680   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
681   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
682 
683   /* Recompute G */
684   ierr = MatDestroy(&lG);CHKERRQ(ierr);
685   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
686   if (print) {
687     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
688     ierr = MatView(lG,NULL);CHKERRQ(ierr);
689     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
690     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
691   }
692 
693   /* Get primal dofs (if any) */
694   cum = 0;
695   for (i=0;i<ne;i++) {
696     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
697   }
698   if (fl2g) {
699     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
700   }
701   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
702   if (print) {
703     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
704     ierr = ISView(primals,NULL);CHKERRQ(ierr);
705   }
706   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
707   /* TODO: what if the user passed in some of them ?  */
708   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
709   ierr = ISDestroy(&primals);CHKERRQ(ierr);
710 
711   /* Compute edge connectivity */
712   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
713   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
714   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
715   if (fl2g) {
716     PetscBT   btf;
717     PetscInt  *iia,*jja,*iiu,*jju;
718     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
719 
720     /* create CSR for all local dofs */
721     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
722     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
723       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);
724       iiu = pcbddc->mat_graph->xadj;
725       jju = pcbddc->mat_graph->adjncy;
726     } else if (pcbddc->use_local_adj) {
727       rest = PETSC_TRUE;
728       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
729     } else {
730       free   = PETSC_TRUE;
731       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
732       iiu[0] = 0;
733       for (i=0;i<n;i++) {
734         iiu[i+1] = i+1;
735         jju[i]   = -1;
736       }
737     }
738 
739     /* import sizes of CSR */
740     iia[0] = 0;
741     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
742 
743     /* overwrite entries corresponding to the Nedelec field */
744     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
745     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
746     for (i=0;i<ne;i++) {
747       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
748       iia[idxs[i]+1] = ii[i+1]-ii[i];
749     }
750 
751     /* iia in CSR */
752     for (i=0;i<n;i++) iia[i+1] += iia[i];
753 
754     /* jja in CSR */
755     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
756     for (i=0;i<n;i++)
757       if (!PetscBTLookup(btf,i))
758         for (j=0;j<iiu[i+1]-iiu[i];j++)
759           jja[iia[i]+j] = jju[iiu[i]+j];
760 
761     /* map edge dofs connectivity */
762     if (jj) {
763       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
764       for (i=0;i<ne;i++) {
765         PetscInt e = idxs[i];
766         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
767       }
768     }
769     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
770     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
771     if (rest) {
772       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
773     }
774     if (free) {
775       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
776     }
777     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
778   } else {
779     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
780   }
781 
782   /* Analyze interface for edge dofs */
783   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
784   pcbddc->mat_graph->twodim = PETSC_FALSE;
785 
786   /* Get coarse edges in the edge space */
787   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
788   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
789 
790   if (fl2g) {
791     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
792     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
793     for (i=0;i<nee;i++) {
794       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
795     }
796   } else {
797     eedges  = alleedges;
798     primals = allprimals;
799   }
800 
801   /* Mark fine edge dofs with their coarse edge id */
802   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
803   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
804   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
805   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
806   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
807   if (print) {
808     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
809     ierr = ISView(primals,NULL);CHKERRQ(ierr);
810   }
811 
812   maxsize = 0;
813   for (i=0;i<nee;i++) {
814     PetscInt size,mark = i+1;
815 
816     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
817     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
818     for (j=0;j<size;j++) marks[idxs[j]] = mark;
819     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
820     maxsize = PetscMax(maxsize,size);
821   }
822 
823   /* Find coarse edge endpoints */
824   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
825   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
826   for (i=0;i<nee;i++) {
827     PetscInt mark = i+1,size;
828 
829     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
830     if (!size && nedfieldlocal) continue;
831     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
832     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
833     if (print) {
834       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
835       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
836     }
837     for (j=0;j<size;j++) {
838       PetscInt k, ee = idxs[j];
839       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
840       for (k=ii[ee];k<ii[ee+1];k++) {
841         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
842         if (PetscBTLookup(btv,jj[k])) {
843           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
844         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
845           PetscInt  k2;
846           PetscBool corner = PETSC_FALSE;
847           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
848             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]));
849             /* it's a corner if either is connected with an edge dof belonging to a different cc or
850                if the edge dof lie on the natural part of the boundary */
851             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
852               corner = PETSC_TRUE;
853               break;
854             }
855           }
856           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
857             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
858             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
859           } else {
860             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
861           }
862         }
863       }
864     }
865     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
866   }
867   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
868   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
869   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
870 
871   /* Reset marked primal dofs */
872   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
873   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
874   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
875   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
876 
877   /* Now use the initial lG */
878   ierr = MatDestroy(&lG);CHKERRQ(ierr);
879   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
880   lG   = lGinit;
881   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
882 
883   /* Compute extended cols indices */
884   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
885   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
886   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
887   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
888   i   *= maxsize;
889   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
890   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
891   eerr = PETSC_FALSE;
892   for (i=0;i<nee;i++) {
893     PetscInt size,found = 0;
894 
895     cum  = 0;
896     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
897     if (!size && nedfieldlocal) continue;
898     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
899     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
900     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
901     for (j=0;j<size;j++) {
902       PetscInt k,ee = idxs[j];
903       for (k=ii[ee];k<ii[ee+1];k++) {
904         PetscInt vv = jj[k];
905         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
906         else if (!PetscBTLookupSet(btvc,vv)) found++;
907       }
908     }
909     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
910     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
911     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
912     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
913     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
914     /* it may happen that endpoints are not defined at this point
915        if it is the case, mark this edge for a second pass */
916     if (cum != size -1 || found != 2) {
917       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
918       if (print) {
919         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
920         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
921         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
922         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
923       }
924       eerr = PETSC_TRUE;
925     }
926   }
927   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
928   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
929   if (done) {
930     PetscInt *newprimals;
931 
932     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
933     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
934     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
935     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
936     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
937     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
938     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
939     for (i=0;i<nee;i++) {
940       PetscBool has_candidates = PETSC_FALSE;
941       if (PetscBTLookup(bter,i)) {
942         PetscInt size,mark = i+1;
943 
944         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
945         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
946         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
947         for (j=0;j<size;j++) {
948           PetscInt k,ee = idxs[j];
949           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
950           for (k=ii[ee];k<ii[ee+1];k++) {
951             /* set all candidates located on the edge as corners */
952             if (PetscBTLookup(btvcand,jj[k])) {
953               PetscInt k2,vv = jj[k];
954               has_candidates = PETSC_TRUE;
955               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
956               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
957               /* set all edge dofs connected to candidate as primals */
958               for (k2=iit[vv];k2<iit[vv+1];k2++) {
959                 if (marks[jjt[k2]] == mark) {
960                   PetscInt k3,ee2 = jjt[k2];
961                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
962                   newprimals[cum++] = ee2;
963                   /* finally set the new corners */
964                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
965                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
966                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
967                   }
968                 }
969               }
970             } else {
971               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
972             }
973           }
974         }
975         if (!has_candidates) { /* circular edge */
976           PetscInt k, ee = idxs[0],*tmarks;
977 
978           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
979           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
980           for (k=ii[ee];k<ii[ee+1];k++) {
981             PetscInt k2;
982             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
983             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
984             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
985           }
986           for (j=0;j<size;j++) {
987             if (tmarks[idxs[j]] > 1) {
988               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
989               newprimals[cum++] = idxs[j];
990             }
991           }
992           ierr = PetscFree(tmarks);CHKERRQ(ierr);
993         }
994         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
995       }
996       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
997     }
998     ierr = PetscFree(extcols);CHKERRQ(ierr);
999     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1000     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1001     if (fl2g) {
1002       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1003       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1004       for (i=0;i<nee;i++) {
1005         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1006       }
1007       ierr = PetscFree(eedges);CHKERRQ(ierr);
1008     }
1009     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1010     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1011     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1012     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1013     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1014     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1015     pcbddc->mat_graph->twodim = PETSC_FALSE;
1016     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1017     if (fl2g) {
1018       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1019       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1020       for (i=0;i<nee;i++) {
1021         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1022       }
1023     } else {
1024       eedges  = alleedges;
1025       primals = allprimals;
1026     }
1027     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1028 
1029     /* Mark again */
1030     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1031     for (i=0;i<nee;i++) {
1032       PetscInt size,mark = i+1;
1033 
1034       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1035       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1036       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1037       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1038     }
1039     if (print) {
1040       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1041       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1042     }
1043 
1044     /* Recompute extended cols */
1045     eerr = PETSC_FALSE;
1046     for (i=0;i<nee;i++) {
1047       PetscInt size;
1048 
1049       cum  = 0;
1050       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1051       if (!size && nedfieldlocal) continue;
1052       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1053       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       for (j=0;j<size;j++) {
1055         PetscInt k,ee = idxs[j];
1056         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1057       }
1058       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1059       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1060       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1061       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1062       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1063       if (cum != size -1) {
1064         if (print) {
1065           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1066           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1067           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1068           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1069         }
1070         eerr = PETSC_TRUE;
1071       }
1072     }
1073   }
1074   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1075   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1076   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1077   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1078   /* an error should not occur at this point */
1079   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1080 
1081   /* Check the number of endpoints */
1082   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1083   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1085   for (i=0;i<nee;i++) {
1086     PetscInt size, found = 0, gc[2];
1087 
1088     /* init with defaults */
1089     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1090     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1091     if (!size && nedfieldlocal) continue;
1092     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1093     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1094     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1095     for (j=0;j<size;j++) {
1096       PetscInt k,ee = idxs[j];
1097       for (k=ii[ee];k<ii[ee+1];k++) {
1098         PetscInt vv = jj[k];
1099         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1100           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1101           corners[i*2+found++] = vv;
1102         }
1103       }
1104     }
1105     if (found != 2) {
1106       PetscInt e;
1107       if (fl2g) {
1108         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1109       } else {
1110         e = idxs[0];
1111       }
1112       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1113     }
1114 
1115     /* get primal dof index on this coarse edge */
1116     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1117     if (gc[0] > gc[1]) {
1118       PetscInt swap  = corners[2*i];
1119       corners[2*i]   = corners[2*i+1];
1120       corners[2*i+1] = swap;
1121     }
1122     cedges[i] = idxs[size-1];
1123     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1124     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1125   }
1126   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1127   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1128 
1129 #if defined(PETSC_USE_DEBUG)
1130   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1131      not interfere with neighbouring coarse edges */
1132   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1133   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   for (i=0;i<nv;i++) {
1135     PetscInt emax = 0,eemax = 0;
1136 
1137     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1138     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1139     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1140     for (j=1;j<nee+1;j++) {
1141       if (emax < emarks[j]) {
1142         emax = emarks[j];
1143         eemax = j;
1144       }
1145     }
1146     /* not relevant for edges */
1147     if (!eemax) continue;
1148 
1149     for (j=ii[i];j<ii[i+1];j++) {
1150       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1151         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]);
1152       }
1153     }
1154   }
1155   ierr = PetscFree(emarks);CHKERRQ(ierr);
1156   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1157 #endif
1158 
1159   /* Compute extended rows indices for edge blocks of the change of basis */
1160   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1161   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1162   extmem *= maxsize;
1163   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1164   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1165   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1166   for (i=0;i<nv;i++) {
1167     PetscInt mark = 0,size,start;
1168 
1169     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1170     for (j=ii[i];j<ii[i+1];j++)
1171       if (marks[jj[j]] && !mark)
1172         mark = marks[jj[j]];
1173 
1174     /* not relevant */
1175     if (!mark) continue;
1176 
1177     /* import extended row */
1178     mark--;
1179     start = mark*extmem+extrowcum[mark];
1180     size = ii[i+1]-ii[i];
1181     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1182     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1183     extrowcum[mark] += size;
1184   }
1185   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1187   ierr = PetscFree(marks);CHKERRQ(ierr);
1188 
1189   /* Compress extrows */
1190   cum  = 0;
1191   for (i=0;i<nee;i++) {
1192     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1193     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1194     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1195     cum  = PetscMax(cum,size);
1196   }
1197   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1198   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1200 
1201   /* Workspace for lapack inner calls and VecSetValues */
1202   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1203 
1204   /* Create change of basis matrix (preallocation can be improved) */
1205   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1206   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1207                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1208   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1209   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1210   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1211   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1212   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1215 
1216   /* Defaults to identity */
1217   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1218   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1219   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1220   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1221 
1222   /* Create discrete gradient for the coarser level if needed */
1223   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1224   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1225   if (pcbddc->current_level < pcbddc->max_levels) {
1226     ISLocalToGlobalMapping cel2g,cvl2g;
1227     IS                     wis,gwis;
1228     PetscInt               cnv,cne;
1229 
1230     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1231     if (fl2g) {
1232       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1233     } else {
1234       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1235       pcbddc->nedclocal = wis;
1236     }
1237     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1238     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1239     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1240     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1241     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1242     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1243 
1244     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1245     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1246     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1247     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1248     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1249     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1250     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1251 
1252     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1253     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1254     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1255     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1256     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1257     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1258     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1260   }
1261   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1262 
1263 #if defined(PRINT_GDET)
1264   inc = 0;
1265   lev = pcbddc->current_level;
1266 #endif
1267 
1268   /* Insert values in the change of basis matrix */
1269   for (i=0;i<nee;i++) {
1270     Mat         Gins = NULL, GKins = NULL;
1271     IS          cornersis = NULL;
1272     PetscScalar cvals[2];
1273 
1274     if (pcbddc->nedcG) {
1275       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1276     }
1277     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1278     if (Gins && GKins) {
1279       PetscScalar    *data;
1280       const PetscInt *rows,*cols;
1281       PetscInt       nrh,nch,nrc,ncc;
1282 
1283       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1284       /* H1 */
1285       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1286       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1287       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1288       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1289       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1290       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1291       /* complement */
1292       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1293       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1294       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);
1295       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);
1296       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1297       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1298       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1299 
1300       /* coarse discrete gradient */
1301       if (pcbddc->nedcG) {
1302         PetscInt cols[2];
1303 
1304         cols[0] = 2*i;
1305         cols[1] = 2*i+1;
1306         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1307       }
1308       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1309     }
1310     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1311     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1313     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1314     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1317 
1318   /* Start assembling */
1319   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1320   if (pcbddc->nedcG) {
1321     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1322   }
1323 
1324   /* Free */
1325   if (fl2g) {
1326     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1327     for (i=0;i<nee;i++) {
1328       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1329     }
1330     ierr = PetscFree(eedges);CHKERRQ(ierr);
1331   }
1332 
1333   /* hack mat_graph with primal dofs on the coarse edges */
1334   {
1335     PCBDDCGraph graph   = pcbddc->mat_graph;
1336     PetscInt    *oqueue = graph->queue;
1337     PetscInt    *ocptr  = graph->cptr;
1338     PetscInt    ncc,*idxs;
1339 
1340     /* find first primal edge */
1341     if (pcbddc->nedclocal) {
1342       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1343     } else {
1344       if (fl2g) {
1345         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1346       }
1347       idxs = cedges;
1348     }
1349     cum = 0;
1350     while (cum < nee && cedges[cum] < 0) cum++;
1351 
1352     /* adapt connected components */
1353     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1354     graph->cptr[0] = 0;
1355     for (i=0,ncc=0;i<graph->ncc;i++) {
1356       PetscInt lc = ocptr[i+1]-ocptr[i];
1357       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1358         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1359         graph->queue[graph->cptr[ncc]] = cedges[cum];
1360         ncc++;
1361         lc--;
1362         cum++;
1363         while (cum < nee && cedges[cum] < 0) cum++;
1364       }
1365       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1366       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1367       ncc++;
1368     }
1369     graph->ncc = ncc;
1370     if (pcbddc->nedclocal) {
1371       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1372     }
1373     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1376   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1378   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1379 
1380   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1381   ierr = PetscFree(extrow);CHKERRQ(ierr);
1382   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1383   ierr = PetscFree(corners);CHKERRQ(ierr);
1384   ierr = PetscFree(cedges);CHKERRQ(ierr);
1385   ierr = PetscFree(extrows);CHKERRQ(ierr);
1386   ierr = PetscFree(extcols);CHKERRQ(ierr);
1387   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1388 
1389   /* Complete assembling */
1390   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1391   if (pcbddc->nedcG) {
1392     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1393 #if 0
1394     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1395     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1396 #endif
1397   }
1398 
1399   /* set change of basis */
1400   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1401   ierr = MatDestroy(&T);CHKERRQ(ierr);
1402 
1403   PetscFunctionReturn(0);
1404 }
1405 
1406 /* the near-null space of BDDC carries information on quadrature weights,
1407    and these can be collinear -> so cheat with MatNullSpaceCreate
1408    and create a suitable set of basis vectors first */
1409 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1410 {
1411   PetscErrorCode ierr;
1412   PetscInt       i;
1413 
1414   PetscFunctionBegin;
1415   for (i=0;i<nvecs;i++) {
1416     PetscInt first,last;
1417 
1418     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1419     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1420     if (i>=first && i < last) {
1421       PetscScalar *data;
1422       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1423       if (!has_const) {
1424         data[i-first] = 1.;
1425       } else {
1426         data[2*i-first] = 1./PetscSqrtReal(2.);
1427         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1428       }
1429       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1430     }
1431     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1432   }
1433   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1434   for (i=0;i<nvecs;i++) { /* reset vectors */
1435     PetscInt first,last;
1436     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1437     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1438     if (i>=first && i < last) {
1439       PetscScalar *data;
1440       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1441       if (!has_const) {
1442         data[i-first] = 0.;
1443       } else {
1444         data[2*i-first] = 0.;
1445         data[2*i-first+1] = 0.;
1446       }
1447       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1448     }
1449     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1450     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1451   }
1452   PetscFunctionReturn(0);
1453 }
1454 
1455 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1456 {
1457   Mat                    loc_divudotp;
1458   Vec                    p,v,vins,quad_vec,*quad_vecs;
1459   ISLocalToGlobalMapping map;
1460   PetscScalar            *vals;
1461   const PetscScalar      *array;
1462   PetscInt               i,maxneighs,maxsize,*gidxs;
1463   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1464   PetscMPIInt            rank;
1465   PetscErrorCode         ierr;
1466 
1467   PetscFunctionBegin;
1468   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1469   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1470   if (!maxneighs) {
1471     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1472     *nnsp = NULL;
1473     PetscFunctionReturn(0);
1474   }
1475   maxsize = 0;
1476   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1477   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1478   /* create vectors to hold quadrature weights */
1479   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1480   if (!transpose) {
1481     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1482   } else {
1483     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1484   }
1485   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1486   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1487   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1488   for (i=0;i<maxneighs;i++) {
1489     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1490   }
1491 
1492   /* compute local quad vec */
1493   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1494   if (!transpose) {
1495     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1496   } else {
1497     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1498   }
1499   ierr = VecSet(p,1.);CHKERRQ(ierr);
1500   if (!transpose) {
1501     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1502   } else {
1503     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1504   }
1505   if (vl2l) {
1506     Mat        lA;
1507     VecScatter sc;
1508 
1509     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1510     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1511     ierr = VecScatterCreateWithData(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1512     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1513     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1515   } else {
1516     vins = v;
1517   }
1518   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1519   ierr = VecDestroy(&p);CHKERRQ(ierr);
1520 
1521   /* insert in global quadrature vecs */
1522   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1523   for (i=0;i<n_neigh;i++) {
1524     const PetscInt    *idxs;
1525     PetscInt          idx,nn,j;
1526 
1527     idxs = shared[i];
1528     nn   = n_shared[i];
1529     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1530     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1531     idx  = -(idx+1);
1532     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1533     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1534   }
1535   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1536   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1537   if (vl2l) {
1538     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1539   }
1540   ierr = VecDestroy(&v);CHKERRQ(ierr);
1541   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1542 
1543   /* assemble near null space */
1544   for (i=0;i<maxneighs;i++) {
1545     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1546   }
1547   for (i=0;i<maxneighs;i++) {
1548     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1549     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1550     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1551   }
1552   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1553   PetscFunctionReturn(0);
1554 }
1555 
1556 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1557 {
1558   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1559   PetscErrorCode ierr;
1560 
1561   PetscFunctionBegin;
1562   if (primalv) {
1563     if (pcbddc->user_primal_vertices_local) {
1564       IS list[2], newp;
1565 
1566       list[0] = primalv;
1567       list[1] = pcbddc->user_primal_vertices_local;
1568       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1569       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1570       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1571       pcbddc->user_primal_vertices_local = newp;
1572     } else {
1573       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1574     }
1575   }
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1580 {
1581   PetscInt f, *comp  = (PetscInt *)ctx;
1582 
1583   PetscFunctionBegin;
1584   for (f=0;f<Nf;f++) out[f] = X[*comp];
1585   PetscFunctionReturn(0);
1586 }
1587 
1588 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1589 {
1590   PetscErrorCode ierr;
1591   Vec            local,global;
1592   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1593   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1594   PetscBool      monolithic = PETSC_FALSE;
1595 
1596   PetscFunctionBegin;
1597   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1598   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1599   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1600   /* need to convert from global to local topology information and remove references to information in global ordering */
1601   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1602   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1603   if (monolithic) { /* just get block size to properly compute vertices */
1604     if (pcbddc->vertex_size == 1) {
1605       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1606     }
1607     goto boundary;
1608   }
1609 
1610   if (pcbddc->user_provided_isfordofs) {
1611     if (pcbddc->n_ISForDofs) {
1612       PetscInt i;
1613 
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         PetscInt bs;
1617 
1618         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1619         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1620         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1621         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1622       }
1623       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1624       pcbddc->n_ISForDofs = 0;
1625       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1626     }
1627   } else {
1628     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1629       DM dm;
1630 
1631       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1632       if (!dm) {
1633         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1634       }
1635       if (dm) {
1636         IS      *fields;
1637         PetscInt nf,i;
1638 
1639         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1640         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1641         for (i=0;i<nf;i++) {
1642           PetscInt bs;
1643 
1644           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1645           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1646           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1647           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1648         }
1649         ierr = PetscFree(fields);CHKERRQ(ierr);
1650         pcbddc->n_ISForDofsLocal = nf;
1651       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1652         PetscContainer   c;
1653 
1654         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1655         if (c) {
1656           MatISLocalFields lf;
1657           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1658           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1659         } else { /* fallback, create the default fields if bs > 1 */
1660           PetscInt i, n = matis->A->rmap->n;
1661           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1662           if (i > 1) {
1663             pcbddc->n_ISForDofsLocal = i;
1664             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1665             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1666               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1667             }
1668           }
1669         }
1670       }
1671     } else {
1672       PetscInt i;
1673       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1674         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1675       }
1676     }
1677   }
1678 
1679 boundary:
1680   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1681     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1682   } else if (pcbddc->DirichletBoundariesLocal) {
1683     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1684   }
1685   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1686     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1687   } else if (pcbddc->NeumannBoundariesLocal) {
1688     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1689   }
1690   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1691     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1692   }
1693   ierr = VecDestroy(&global);CHKERRQ(ierr);
1694   ierr = VecDestroy(&local);CHKERRQ(ierr);
1695   /* detect local disconnected subdomains if requested (use matis->A) */
1696   if (pcbddc->detect_disconnected) {
1697     IS        primalv = NULL;
1698     PetscInt  i;
1699     PetscBool filter = pcbddc->detect_disconnected_filter;
1700 
1701     for (i=0;i<pcbddc->n_local_subs;i++) {
1702       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1703     }
1704     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1705     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1706     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1707     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1708   }
1709   /* early stage corner detection */
1710   {
1711     DM dm;
1712 
1713     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1714     if (!dm) {
1715       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1716     }
1717     if (dm) {
1718       PetscBool isda;
1719 
1720       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1721       if (isda) {
1722         ISLocalToGlobalMapping l2l;
1723         IS                     corners;
1724         Mat                    lA;
1725         PetscBool              gl,lo;
1726 
1727         {
1728           Vec               cvec;
1729           const PetscScalar *coords;
1730           PetscInt          dof,n,cdim;
1731           PetscBool         memc = PETSC_TRUE;
1732 
1733           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1734           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1735           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1736           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1737           n   /= cdim;
1738           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1739           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1740           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1741 #if defined(PETSC_USE_COMPLEX)
1742           memc = PETSC_FALSE;
1743 #endif
1744           if (dof != 1) memc = PETSC_FALSE;
1745           if (memc) {
1746             ierr = PetscMemcpy(pcbddc->mat_graph->coords,coords,cdim*n*dof*sizeof(PetscReal));CHKERRQ(ierr);
1747           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1748             PetscReal *bcoords = pcbddc->mat_graph->coords;
1749             PetscInt  i, b, d;
1750 
1751             for (i=0;i<n;i++) {
1752               for (b=0;b<dof;b++) {
1753                 for (d=0;d<cdim;d++) {
1754                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1755                 }
1756               }
1757             }
1758           }
1759           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1760           pcbddc->mat_graph->cdim  = cdim;
1761           pcbddc->mat_graph->cnloc = dof*n;
1762           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1763         }
1764         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1765         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1766         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1767         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1768         lo   = (PetscBool)(l2l && corners);
1769         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1770         if (gl) { /* From PETSc's DMDA */
1771           const PetscInt    *idx;
1772           PetscInt          dof,bs,*idxout,n;
1773 
1774           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1775           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1776           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1777           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1778           if (bs == dof) {
1779             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1780             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1781           } else { /* the original DMDA local-to-local map have been modified */
1782             PetscInt i,d;
1783 
1784             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1785             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1786             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1787 
1788             bs = 1;
1789             n *= dof;
1790           }
1791           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1792           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1793           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1794           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1795           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1796           pcbddc->corner_selected  = PETSC_TRUE;
1797           pcbddc->corner_selection = PETSC_TRUE;
1798         }
1799         if (corners) {
1800           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1801         }
1802       }
1803     }
1804   }
1805   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1806     DM dm;
1807 
1808     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1809     if (!dm) {
1810       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1811     }
1812     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1813       Vec            vcoords;
1814       PetscSection   section;
1815       PetscReal      *coords;
1816       PetscInt       d,cdim,nl,nf,**ctxs;
1817       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1818 
1819       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1820       ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
1821       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1822       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1823       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1824       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1825       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1826       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1827       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1828       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1829       for (d=0;d<cdim;d++) {
1830         PetscInt          i;
1831         const PetscScalar *v;
1832 
1833         for (i=0;i<nf;i++) ctxs[i][0] = d;
1834         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1835         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1836         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1837         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1838       }
1839       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1840       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1841       ierr = PetscFree(coords);CHKERRQ(ierr);
1842       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1843       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1844     }
1845   }
1846   PetscFunctionReturn(0);
1847 }
1848 
1849 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1850 {
1851   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1852   PetscErrorCode  ierr;
1853   IS              nis;
1854   const PetscInt  *idxs;
1855   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1856   PetscBool       *ld;
1857 
1858   PetscFunctionBegin;
1859   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1860   if (mop == MPI_LAND) {
1861     /* init rootdata with true */
1862     ld   = (PetscBool*) matis->sf_rootdata;
1863     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1864   } else {
1865     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1866   }
1867   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1868   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1869   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1870   ld   = (PetscBool*) matis->sf_leafdata;
1871   for (i=0;i<nd;i++)
1872     if (-1 < idxs[i] && idxs[i] < n)
1873       ld[idxs[i]] = PETSC_TRUE;
1874   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1875   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1876   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1877   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1878   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1879   if (mop == MPI_LAND) {
1880     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1881   } else {
1882     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1883   }
1884   for (i=0,nnd=0;i<n;i++)
1885     if (ld[i])
1886       nidxs[nnd++] = i;
1887   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1888   ierr = ISDestroy(is);CHKERRQ(ierr);
1889   *is  = nis;
1890   PetscFunctionReturn(0);
1891 }
1892 
1893 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1894 {
1895   PC_IS             *pcis = (PC_IS*)(pc->data);
1896   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1897   PetscErrorCode    ierr;
1898 
1899   PetscFunctionBegin;
1900   if (!pcbddc->benign_have_null) {
1901     PetscFunctionReturn(0);
1902   }
1903   if (pcbddc->ChangeOfBasisMatrix) {
1904     Vec swap;
1905 
1906     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1907     swap = pcbddc->work_change;
1908     pcbddc->work_change = r;
1909     r = swap;
1910   }
1911   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1912   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1913   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1914   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1915   ierr = VecSet(z,0.);CHKERRQ(ierr);
1916   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1917   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1918   if (pcbddc->ChangeOfBasisMatrix) {
1919     pcbddc->work_change = r;
1920     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1921     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1922   }
1923   PetscFunctionReturn(0);
1924 }
1925 
1926 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1927 {
1928   PCBDDCBenignMatMult_ctx ctx;
1929   PetscErrorCode          ierr;
1930   PetscBool               apply_right,apply_left,reset_x;
1931 
1932   PetscFunctionBegin;
1933   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1934   if (transpose) {
1935     apply_right = ctx->apply_left;
1936     apply_left = ctx->apply_right;
1937   } else {
1938     apply_right = ctx->apply_right;
1939     apply_left = ctx->apply_left;
1940   }
1941   reset_x = PETSC_FALSE;
1942   if (apply_right) {
1943     const PetscScalar *ax;
1944     PetscInt          nl,i;
1945 
1946     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1947     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1948     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1949     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1950     for (i=0;i<ctx->benign_n;i++) {
1951       PetscScalar    sum,val;
1952       const PetscInt *idxs;
1953       PetscInt       nz,j;
1954       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1955       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1956       sum = 0.;
1957       if (ctx->apply_p0) {
1958         val = ctx->work[idxs[nz-1]];
1959         for (j=0;j<nz-1;j++) {
1960           sum += ctx->work[idxs[j]];
1961           ctx->work[idxs[j]] += val;
1962         }
1963       } else {
1964         for (j=0;j<nz-1;j++) {
1965           sum += ctx->work[idxs[j]];
1966         }
1967       }
1968       ctx->work[idxs[nz-1]] -= sum;
1969       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1970     }
1971     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1972     reset_x = PETSC_TRUE;
1973   }
1974   if (transpose) {
1975     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1976   } else {
1977     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1978   }
1979   if (reset_x) {
1980     ierr = VecResetArray(x);CHKERRQ(ierr);
1981   }
1982   if (apply_left) {
1983     PetscScalar *ay;
1984     PetscInt    i;
1985 
1986     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1987     for (i=0;i<ctx->benign_n;i++) {
1988       PetscScalar    sum,val;
1989       const PetscInt *idxs;
1990       PetscInt       nz,j;
1991       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1992       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1993       val = -ay[idxs[nz-1]];
1994       if (ctx->apply_p0) {
1995         sum = 0.;
1996         for (j=0;j<nz-1;j++) {
1997           sum += ay[idxs[j]];
1998           ay[idxs[j]] += val;
1999         }
2000         ay[idxs[nz-1]] += sum;
2001       } else {
2002         for (j=0;j<nz-1;j++) {
2003           ay[idxs[j]] += val;
2004         }
2005         ay[idxs[nz-1]] = 0.;
2006       }
2007       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2008     }
2009     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2010   }
2011   PetscFunctionReturn(0);
2012 }
2013 
2014 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2015 {
2016   PetscErrorCode ierr;
2017 
2018   PetscFunctionBegin;
2019   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2020   PetscFunctionReturn(0);
2021 }
2022 
2023 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2024 {
2025   PetscErrorCode ierr;
2026 
2027   PetscFunctionBegin;
2028   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2029   PetscFunctionReturn(0);
2030 }
2031 
2032 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2033 {
2034   PC_IS                   *pcis = (PC_IS*)pc->data;
2035   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2036   PCBDDCBenignMatMult_ctx ctx;
2037   PetscErrorCode          ierr;
2038 
2039   PetscFunctionBegin;
2040   if (!restore) {
2041     Mat                A_IB,A_BI;
2042     PetscScalar        *work;
2043     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2044 
2045     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2046     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2047     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2048     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2049     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2050     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2051     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2052     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2053     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2054     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2055     ctx->apply_left = PETSC_TRUE;
2056     ctx->apply_right = PETSC_FALSE;
2057     ctx->apply_p0 = PETSC_FALSE;
2058     ctx->benign_n = pcbddc->benign_n;
2059     if (reuse) {
2060       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2061       ctx->free = PETSC_FALSE;
2062     } else { /* TODO: could be optimized for successive solves */
2063       ISLocalToGlobalMapping N_to_D;
2064       PetscInt               i;
2065 
2066       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2067       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2068       for (i=0;i<pcbddc->benign_n;i++) {
2069         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2070       }
2071       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2072       ctx->free = PETSC_TRUE;
2073     }
2074     ctx->A = pcis->A_IB;
2075     ctx->work = work;
2076     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2077     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2078     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2079     pcis->A_IB = A_IB;
2080 
2081     /* A_BI as A_IB^T */
2082     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2083     pcbddc->benign_original_mat = pcis->A_BI;
2084     pcis->A_BI = A_BI;
2085   } else {
2086     if (!pcbddc->benign_original_mat) {
2087       PetscFunctionReturn(0);
2088     }
2089     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2090     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2091     pcis->A_IB = ctx->A;
2092     ctx->A = NULL;
2093     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2094     pcis->A_BI = pcbddc->benign_original_mat;
2095     pcbddc->benign_original_mat = NULL;
2096     if (ctx->free) {
2097       PetscInt i;
2098       for (i=0;i<ctx->benign_n;i++) {
2099         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2100       }
2101       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2102     }
2103     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2104     ierr = PetscFree(ctx);CHKERRQ(ierr);
2105   }
2106   PetscFunctionReturn(0);
2107 }
2108 
2109 /* used just in bddc debug mode */
2110 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2111 {
2112   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2113   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2114   Mat            An;
2115   PetscErrorCode ierr;
2116 
2117   PetscFunctionBegin;
2118   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2119   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2120   if (is1) {
2121     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2122     ierr = MatDestroy(&An);CHKERRQ(ierr);
2123   } else {
2124     *B = An;
2125   }
2126   PetscFunctionReturn(0);
2127 }
2128 
2129 /* TODO: add reuse flag */
2130 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2131 {
2132   Mat            Bt;
2133   PetscScalar    *a,*bdata;
2134   const PetscInt *ii,*ij;
2135   PetscInt       m,n,i,nnz,*bii,*bij;
2136   PetscBool      flg_row;
2137   PetscErrorCode ierr;
2138 
2139   PetscFunctionBegin;
2140   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2141   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2142   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2143   nnz = n;
2144   for (i=0;i<ii[n];i++) {
2145     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2146   }
2147   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2148   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2149   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2150   nnz = 0;
2151   bii[0] = 0;
2152   for (i=0;i<n;i++) {
2153     PetscInt j;
2154     for (j=ii[i];j<ii[i+1];j++) {
2155       PetscScalar entry = a[j];
2156       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2157         bij[nnz] = ij[j];
2158         bdata[nnz] = entry;
2159         nnz++;
2160       }
2161     }
2162     bii[i+1] = nnz;
2163   }
2164   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2165   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2166   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2167   {
2168     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2169     b->free_a = PETSC_TRUE;
2170     b->free_ij = PETSC_TRUE;
2171   }
2172   if (*B == A) {
2173     ierr = MatDestroy(&A);CHKERRQ(ierr);
2174   }
2175   *B = Bt;
2176   PetscFunctionReturn(0);
2177 }
2178 
2179 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2180 {
2181   Mat                    B = NULL;
2182   DM                     dm;
2183   IS                     is_dummy,*cc_n;
2184   ISLocalToGlobalMapping l2gmap_dummy;
2185   PCBDDCGraph            graph;
2186   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2187   PetscInt               i,n;
2188   PetscInt               *xadj,*adjncy;
2189   PetscBool              isplex = PETSC_FALSE;
2190   PetscErrorCode         ierr;
2191 
2192   PetscFunctionBegin;
2193   if (ncc) *ncc = 0;
2194   if (cc) *cc = NULL;
2195   if (primalv) *primalv = NULL;
2196   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2197   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2198   if (!dm) {
2199     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2200   }
2201   if (dm) {
2202     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2203   }
2204   if (filter) isplex = PETSC_FALSE;
2205 
2206   if (isplex) { /* this code has been modified from plexpartition.c */
2207     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2208     PetscInt      *adj = NULL;
2209     IS             cellNumbering;
2210     const PetscInt *cellNum;
2211     PetscBool      useCone, useClosure;
2212     PetscSection   section;
2213     PetscSegBuffer adjBuffer;
2214     PetscSF        sfPoint;
2215     PetscErrorCode ierr;
2216 
2217     PetscFunctionBegin;
2218     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2219     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2220     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2221     /* Build adjacency graph via a section/segbuffer */
2222     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2223     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2224     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2225     /* Always use FVM adjacency to create partitioner graph */
2226     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2227     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2228     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2229     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2230     for (n = 0, p = pStart; p < pEnd; p++) {
2231       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2232       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2233       adjSize = PETSC_DETERMINE;
2234       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2235       for (a = 0; a < adjSize; ++a) {
2236         const PetscInt point = adj[a];
2237         if (pStart <= point && point < pEnd) {
2238           PetscInt *PETSC_RESTRICT pBuf;
2239           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2240           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2241           *pBuf = point;
2242         }
2243       }
2244       n++;
2245     }
2246     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2247     /* Derive CSR graph from section/segbuffer */
2248     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2249     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2250     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2251     for (idx = 0, p = pStart; p < pEnd; p++) {
2252       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2253       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2254     }
2255     xadj[n] = size;
2256     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2257     /* Clean up */
2258     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2259     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2260     ierr = PetscFree(adj);CHKERRQ(ierr);
2261     graph->xadj = xadj;
2262     graph->adjncy = adjncy;
2263   } else {
2264     Mat       A;
2265     PetscBool isseqaij, flg_row;
2266 
2267     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2268     if (!A->rmap->N || !A->cmap->N) {
2269       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2270       PetscFunctionReturn(0);
2271     }
2272     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2273     if (!isseqaij && filter) {
2274       PetscBool isseqdense;
2275 
2276       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2277       if (!isseqdense) {
2278         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2279       } else { /* TODO: rectangular case and LDA */
2280         PetscScalar *array;
2281         PetscReal   chop=1.e-6;
2282 
2283         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2284         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2285         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2286         for (i=0;i<n;i++) {
2287           PetscInt j;
2288           for (j=i+1;j<n;j++) {
2289             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2290             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2291             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2292           }
2293         }
2294         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2295         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2296       }
2297     } else {
2298       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2299       B = A;
2300     }
2301     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2302 
2303     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2304     if (filter) {
2305       PetscScalar *data;
2306       PetscInt    j,cum;
2307 
2308       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2309       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2310       cum = 0;
2311       for (i=0;i<n;i++) {
2312         PetscInt t;
2313 
2314         for (j=xadj[i];j<xadj[i+1];j++) {
2315           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2316             continue;
2317           }
2318           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2319         }
2320         t = xadj_filtered[i];
2321         xadj_filtered[i] = cum;
2322         cum += t;
2323       }
2324       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2325       graph->xadj = xadj_filtered;
2326       graph->adjncy = adjncy_filtered;
2327     } else {
2328       graph->xadj = xadj;
2329       graph->adjncy = adjncy;
2330     }
2331   }
2332   /* compute local connected components using PCBDDCGraph */
2333   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2334   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2335   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2336   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2337   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2338   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2339   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2340 
2341   /* partial clean up */
2342   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2343   if (B) {
2344     PetscBool flg_row;
2345     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2346     ierr = MatDestroy(&B);CHKERRQ(ierr);
2347   }
2348   if (isplex) {
2349     ierr = PetscFree(xadj);CHKERRQ(ierr);
2350     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2351   }
2352 
2353   /* get back data */
2354   if (isplex) {
2355     if (ncc) *ncc = graph->ncc;
2356     if (cc || primalv) {
2357       Mat          A;
2358       PetscBT      btv,btvt;
2359       PetscSection subSection;
2360       PetscInt     *ids,cum,cump,*cids,*pids;
2361 
2362       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2363       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2364       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2365       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2366       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2367 
2368       cids[0] = 0;
2369       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2370         PetscInt j;
2371 
2372         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2373         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2374           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2375 
2376           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2377           for (k = 0; k < 2*size; k += 2) {
2378             PetscInt s, p = closure[k], off, dof, cdof;
2379 
2380             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2381             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2382             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2383             for (s = 0; s < dof-cdof; s++) {
2384               if (PetscBTLookupSet(btvt,off+s)) continue;
2385               if (!PetscBTLookup(btv,off+s)) {
2386                 ids[cum++] = off+s;
2387               } else { /* cross-vertex */
2388                 pids[cump++] = off+s;
2389               }
2390             }
2391           }
2392           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2393         }
2394         cids[i+1] = cum;
2395         /* mark dofs as already assigned */
2396         for (j = cids[i]; j < cids[i+1]; j++) {
2397           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2398         }
2399       }
2400       if (cc) {
2401         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2402         for (i = 0; i < graph->ncc; i++) {
2403           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2404         }
2405         *cc = cc_n;
2406       }
2407       if (primalv) {
2408         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2409       }
2410       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2411       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2412       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2413     }
2414   } else {
2415     if (ncc) *ncc = graph->ncc;
2416     if (cc) {
2417       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2418       for (i=0;i<graph->ncc;i++) {
2419         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);
2420       }
2421       *cc = cc_n;
2422     }
2423   }
2424   /* clean up graph */
2425   graph->xadj = 0;
2426   graph->adjncy = 0;
2427   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2428   PetscFunctionReturn(0);
2429 }
2430 
2431 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2432 {
2433   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2434   PC_IS*         pcis = (PC_IS*)(pc->data);
2435   IS             dirIS = NULL;
2436   PetscInt       i;
2437   PetscErrorCode ierr;
2438 
2439   PetscFunctionBegin;
2440   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2441   if (zerodiag) {
2442     Mat            A;
2443     Vec            vec3_N;
2444     PetscScalar    *vals;
2445     const PetscInt *idxs;
2446     PetscInt       nz,*count;
2447 
2448     /* p0 */
2449     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2450     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2451     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2452     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2453     for (i=0;i<nz;i++) vals[i] = 1.;
2454     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2455     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2456     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2457     /* v_I */
2458     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2459     for (i=0;i<nz;i++) vals[i] = 0.;
2460     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2461     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2462     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2463     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2464     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2465     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2466     if (dirIS) {
2467       PetscInt n;
2468 
2469       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2470       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2471       for (i=0;i<n;i++) vals[i] = 0.;
2472       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2473       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2474     }
2475     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2476     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2477     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2478     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2479     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2480     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2481     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2482     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]));
2483     ierr = PetscFree(vals);CHKERRQ(ierr);
2484     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2485 
2486     /* there should not be any pressure dofs lying on the interface */
2487     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2488     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2489     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2490     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2491     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2492     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]);
2493     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2494     ierr = PetscFree(count);CHKERRQ(ierr);
2495   }
2496   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2497 
2498   /* check PCBDDCBenignGetOrSetP0 */
2499   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2500   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2501   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2502   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2503   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2504   for (i=0;i<pcbddc->benign_n;i++) {
2505     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2506     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);
2507   }
2508   PetscFunctionReturn(0);
2509 }
2510 
2511 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2512 {
2513   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2514   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2515   PetscInt       nz,n,benign_n,bsp = 1;
2516   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2517   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2518   PetscErrorCode ierr;
2519 
2520   PetscFunctionBegin;
2521   if (reuse) goto project_b0;
2522   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2523   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2524   for (n=0;n<pcbddc->benign_n;n++) {
2525     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2526   }
2527   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2528   has_null_pressures = PETSC_TRUE;
2529   have_null = PETSC_TRUE;
2530   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2531      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2532      Checks if all the pressure dofs in each subdomain have a zero diagonal
2533      If not, a change of basis on pressures is not needed
2534      since the local Schur complements are already SPD
2535   */
2536   if (pcbddc->n_ISForDofsLocal) {
2537     IS        iP = NULL;
2538     PetscInt  p,*pp;
2539     PetscBool flg;
2540 
2541     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2542     n    = pcbddc->n_ISForDofsLocal;
2543     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2544     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2545     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2546     if (!flg) {
2547       n = 1;
2548       pp[0] = pcbddc->n_ISForDofsLocal-1;
2549     }
2550 
2551     bsp = 0;
2552     for (p=0;p<n;p++) {
2553       PetscInt bs;
2554 
2555       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]);
2556       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2557       bsp += bs;
2558     }
2559     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2560     bsp  = 0;
2561     for (p=0;p<n;p++) {
2562       const PetscInt *idxs;
2563       PetscInt       b,bs,npl,*bidxs;
2564 
2565       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2566       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2567       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2568       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2569       for (b=0;b<bs;b++) {
2570         PetscInt i;
2571 
2572         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2573         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2574         bsp++;
2575       }
2576       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2577       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2578     }
2579     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2580 
2581     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2582     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2583     if (iP) {
2584       IS newpressures;
2585 
2586       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2587       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2588       pressures = newpressures;
2589     }
2590     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2591     if (!sorted) {
2592       ierr = ISSort(pressures);CHKERRQ(ierr);
2593     }
2594     ierr = PetscFree(pp);CHKERRQ(ierr);
2595   }
2596 
2597   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2598   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2599   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2600   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2601   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2602   if (!sorted) {
2603     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2604   }
2605   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2606   zerodiag_save = zerodiag;
2607   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2608   if (!nz) {
2609     if (n) have_null = PETSC_FALSE;
2610     has_null_pressures = PETSC_FALSE;
2611     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2612   }
2613   recompute_zerodiag = PETSC_FALSE;
2614 
2615   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2616   zerodiag_subs    = NULL;
2617   benign_n         = 0;
2618   n_interior_dofs  = 0;
2619   interior_dofs    = NULL;
2620   nneu             = 0;
2621   if (pcbddc->NeumannBoundariesLocal) {
2622     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2623   }
2624   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2625   if (checkb) { /* need to compute interior nodes */
2626     PetscInt n,i,j;
2627     PetscInt n_neigh,*neigh,*n_shared,**shared;
2628     PetscInt *iwork;
2629 
2630     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2631     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2632     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2633     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2634     for (i=1;i<n_neigh;i++)
2635       for (j=0;j<n_shared[i];j++)
2636           iwork[shared[i][j]] += 1;
2637     for (i=0;i<n;i++)
2638       if (!iwork[i])
2639         interior_dofs[n_interior_dofs++] = i;
2640     ierr = PetscFree(iwork);CHKERRQ(ierr);
2641     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2642   }
2643   if (has_null_pressures) {
2644     IS             *subs;
2645     PetscInt       nsubs,i,j,nl;
2646     const PetscInt *idxs;
2647     PetscScalar    *array;
2648     Vec            *work;
2649     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2650 
2651     subs  = pcbddc->local_subs;
2652     nsubs = pcbddc->n_local_subs;
2653     /* 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) */
2654     if (checkb) {
2655       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2656       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2657       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2658       /* work[0] = 1_p */
2659       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2660       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2661       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2662       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2663       /* work[0] = 1_v */
2664       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2665       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2666       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2667       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2668       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2669     }
2670 
2671     if (nsubs > 1 || bsp > 1) {
2672       IS       *is;
2673       PetscInt b,totb;
2674 
2675       totb  = bsp;
2676       is    = bsp > 1 ? bzerodiag : &zerodiag;
2677       nsubs = PetscMax(nsubs,1);
2678       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2679       for (b=0;b<totb;b++) {
2680         for (i=0;i<nsubs;i++) {
2681           ISLocalToGlobalMapping l2g;
2682           IS                     t_zerodiag_subs;
2683           PetscInt               nl;
2684 
2685           if (subs) {
2686             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2687           } else {
2688             IS tis;
2689 
2690             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2691             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2692             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2693             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2694           }
2695           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2696           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2697           if (nl) {
2698             PetscBool valid = PETSC_TRUE;
2699 
2700             if (checkb) {
2701               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2702               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2703               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2704               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2705               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2706               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2707               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2708               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2709               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2710               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2711               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2712               for (j=0;j<n_interior_dofs;j++) {
2713                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2714                   valid = PETSC_FALSE;
2715                   break;
2716                 }
2717               }
2718               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2719             }
2720             if (valid && nneu) {
2721               const PetscInt *idxs;
2722               PetscInt       nzb;
2723 
2724               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2725               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2726               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2727               if (nzb) valid = PETSC_FALSE;
2728             }
2729             if (valid && pressures) {
2730               IS       t_pressure_subs,tmp;
2731               PetscInt i1,i2;
2732 
2733               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2734               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2735               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2736               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2737               if (i2 != i1) valid = PETSC_FALSE;
2738               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2739               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2740             }
2741             if (valid) {
2742               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2743               benign_n++;
2744             } else recompute_zerodiag = PETSC_TRUE;
2745           }
2746           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2747           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2748         }
2749       }
2750     } else { /* there's just one subdomain (or zero if they have not been detected */
2751       PetscBool valid = PETSC_TRUE;
2752 
2753       if (nneu) valid = PETSC_FALSE;
2754       if (valid && pressures) {
2755         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2756       }
2757       if (valid && checkb) {
2758         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2759         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2760         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2761         for (j=0;j<n_interior_dofs;j++) {
2762           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2763             valid = PETSC_FALSE;
2764             break;
2765           }
2766         }
2767         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2768       }
2769       if (valid) {
2770         benign_n = 1;
2771         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2772         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2773         zerodiag_subs[0] = zerodiag;
2774       }
2775     }
2776     if (checkb) {
2777       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2778     }
2779   }
2780   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2781 
2782   if (!benign_n) {
2783     PetscInt n;
2784 
2785     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2786     recompute_zerodiag = PETSC_FALSE;
2787     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2788     if (n) have_null = PETSC_FALSE;
2789   }
2790 
2791   /* final check for null pressures */
2792   if (zerodiag && pressures) {
2793     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2794   }
2795 
2796   if (recompute_zerodiag) {
2797     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2798     if (benign_n == 1) {
2799       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2800       zerodiag = zerodiag_subs[0];
2801     } else {
2802       PetscInt i,nzn,*new_idxs;
2803 
2804       nzn = 0;
2805       for (i=0;i<benign_n;i++) {
2806         PetscInt ns;
2807         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2808         nzn += ns;
2809       }
2810       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2811       nzn = 0;
2812       for (i=0;i<benign_n;i++) {
2813         PetscInt ns,*idxs;
2814         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2815         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2816         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2817         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2818         nzn += ns;
2819       }
2820       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2821       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2822     }
2823     have_null = PETSC_FALSE;
2824   }
2825 
2826   /* determines if the coarse solver will be singular or not */
2827   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2828 
2829   /* Prepare matrix to compute no-net-flux */
2830   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2831     Mat                    A,loc_divudotp;
2832     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2833     IS                     row,col,isused = NULL;
2834     PetscInt               M,N,n,st,n_isused;
2835 
2836     if (pressures) {
2837       isused = pressures;
2838     } else {
2839       isused = zerodiag_save;
2840     }
2841     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2842     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2843     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2844     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");
2845     n_isused = 0;
2846     if (isused) {
2847       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2848     }
2849     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2850     st = st-n_isused;
2851     if (n) {
2852       const PetscInt *gidxs;
2853 
2854       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2855       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2856       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2857       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2858       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2859       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2860     } else {
2861       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2862       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2863       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2864     }
2865     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2866     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2867     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2868     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2869     ierr = ISDestroy(&row);CHKERRQ(ierr);
2870     ierr = ISDestroy(&col);CHKERRQ(ierr);
2871     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2872     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2873     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2874     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2875     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2876     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2877     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2878     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2879     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2880     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2881   }
2882   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2883   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2884   if (bzerodiag) {
2885     PetscInt i;
2886 
2887     for (i=0;i<bsp;i++) {
2888       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2889     }
2890     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2891   }
2892   pcbddc->benign_n = benign_n;
2893   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2894 
2895   /* determines if the problem has subdomains with 0 pressure block */
2896   have_null = (PetscBool)(!!pcbddc->benign_n);
2897   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2898 
2899 project_b0:
2900   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2901   /* change of basis and p0 dofs */
2902   if (pcbddc->benign_n) {
2903     PetscInt i,s,*nnz;
2904 
2905     /* local change of basis for pressures */
2906     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2907     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2908     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2909     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2910     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2911     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2912     for (i=0;i<pcbddc->benign_n;i++) {
2913       const PetscInt *idxs;
2914       PetscInt       nzs,j;
2915 
2916       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2917       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2918       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2919       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2920       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2921     }
2922     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2923     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2924     ierr = PetscFree(nnz);CHKERRQ(ierr);
2925     /* set identity by default */
2926     for (i=0;i<n;i++) {
2927       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2928     }
2929     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2930     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2931     /* set change on pressures */
2932     for (s=0;s<pcbddc->benign_n;s++) {
2933       PetscScalar    *array;
2934       const PetscInt *idxs;
2935       PetscInt       nzs;
2936 
2937       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2938       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2939       for (i=0;i<nzs-1;i++) {
2940         PetscScalar vals[2];
2941         PetscInt    cols[2];
2942 
2943         cols[0] = idxs[i];
2944         cols[1] = idxs[nzs-1];
2945         vals[0] = 1.;
2946         vals[1] = 1.;
2947         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2948       }
2949       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2950       for (i=0;i<nzs-1;i++) array[i] = -1.;
2951       array[nzs-1] = 1.;
2952       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2953       /* store local idxs for p0 */
2954       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2955       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2956       ierr = PetscFree(array);CHKERRQ(ierr);
2957     }
2958     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2959     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2960 
2961     /* project if needed */
2962     if (pcbddc->benign_change_explicit) {
2963       Mat M;
2964 
2965       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2966       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2967       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2968       ierr = MatDestroy(&M);CHKERRQ(ierr);
2969     }
2970     /* store global idxs for p0 */
2971     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2972   }
2973   *zerodiaglocal = zerodiag;
2974   PetscFunctionReturn(0);
2975 }
2976 
2977 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2978 {
2979   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2980   PetscScalar    *array;
2981   PetscErrorCode ierr;
2982 
2983   PetscFunctionBegin;
2984   if (!pcbddc->benign_sf) {
2985     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2986     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2987   }
2988   if (get) {
2989     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2990     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2991     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2992     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2993   } else {
2994     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2995     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2996     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2997     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2998   }
2999   PetscFunctionReturn(0);
3000 }
3001 
3002 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3003 {
3004   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3005   PetscErrorCode ierr;
3006 
3007   PetscFunctionBegin;
3008   /* TODO: add error checking
3009     - avoid nested pop (or push) calls.
3010     - cannot push before pop.
3011     - cannot call this if pcbddc->local_mat is NULL
3012   */
3013   if (!pcbddc->benign_n) {
3014     PetscFunctionReturn(0);
3015   }
3016   if (pop) {
3017     if (pcbddc->benign_change_explicit) {
3018       IS       is_p0;
3019       MatReuse reuse;
3020 
3021       /* extract B_0 */
3022       reuse = MAT_INITIAL_MATRIX;
3023       if (pcbddc->benign_B0) {
3024         reuse = MAT_REUSE_MATRIX;
3025       }
3026       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3027       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3028       /* remove rows and cols from local problem */
3029       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3030       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3031       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3032       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3033     } else {
3034       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3035       PetscScalar *vals;
3036       PetscInt    i,n,*idxs_ins;
3037 
3038       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3039       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3040       if (!pcbddc->benign_B0) {
3041         PetscInt *nnz;
3042         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3043         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3044         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3045         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3046         for (i=0;i<pcbddc->benign_n;i++) {
3047           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3048           nnz[i] = n - nnz[i];
3049         }
3050         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3051         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3052         ierr = PetscFree(nnz);CHKERRQ(ierr);
3053       }
3054 
3055       for (i=0;i<pcbddc->benign_n;i++) {
3056         PetscScalar *array;
3057         PetscInt    *idxs,j,nz,cum;
3058 
3059         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3060         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3061         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3062         for (j=0;j<nz;j++) vals[j] = 1.;
3063         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3064         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3065         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3066         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3067         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3068         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3069         cum = 0;
3070         for (j=0;j<n;j++) {
3071           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3072             vals[cum] = array[j];
3073             idxs_ins[cum] = j;
3074             cum++;
3075           }
3076         }
3077         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3078         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3079         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3080       }
3081       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3082       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3083       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3084     }
3085   } else { /* push */
3086     if (pcbddc->benign_change_explicit) {
3087       PetscInt i;
3088 
3089       for (i=0;i<pcbddc->benign_n;i++) {
3090         PetscScalar *B0_vals;
3091         PetscInt    *B0_cols,B0_ncol;
3092 
3093         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3094         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3095         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3096         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3097         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3098       }
3099       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3100       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3101     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3102   }
3103   PetscFunctionReturn(0);
3104 }
3105 
3106 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3107 {
3108   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3109   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3110   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3111   PetscBLASInt    *B_iwork,*B_ifail;
3112   PetscScalar     *work,lwork;
3113   PetscScalar     *St,*S,*eigv;
3114   PetscScalar     *Sarray,*Starray;
3115   PetscReal       *eigs,thresh,lthresh,uthresh;
3116   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3117   PetscBool       allocated_S_St;
3118 #if defined(PETSC_USE_COMPLEX)
3119   PetscReal       *rwork;
3120 #endif
3121   PetscErrorCode  ierr;
3122 
3123   PetscFunctionBegin;
3124   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3125   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3126   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);
3127   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3128 
3129   if (pcbddc->dbg_flag) {
3130     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3131     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3132     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3133     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3134   }
3135 
3136   if (pcbddc->dbg_flag) {
3137     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);
3138   }
3139 
3140   /* max size of subsets */
3141   mss = 0;
3142   for (i=0;i<sub_schurs->n_subs;i++) {
3143     PetscInt subset_size;
3144 
3145     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3146     mss = PetscMax(mss,subset_size);
3147   }
3148 
3149   /* min/max and threshold */
3150   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3151   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3152   nmax = PetscMax(nmin,nmax);
3153   allocated_S_St = PETSC_FALSE;
3154   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3155     allocated_S_St = PETSC_TRUE;
3156   }
3157 
3158   /* allocate lapack workspace */
3159   cum = cum2 = 0;
3160   maxneigs = 0;
3161   for (i=0;i<sub_schurs->n_subs;i++) {
3162     PetscInt n,subset_size;
3163 
3164     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3165     n = PetscMin(subset_size,nmax);
3166     cum += subset_size;
3167     cum2 += subset_size*n;
3168     maxneigs = PetscMax(maxneigs,n);
3169   }
3170   if (mss) {
3171     if (sub_schurs->is_symmetric) {
3172       PetscBLASInt B_itype = 1;
3173       PetscBLASInt B_N = mss;
3174       PetscReal    zero = 0.0;
3175       PetscReal    eps = 0.0; /* dlamch? */
3176 
3177       B_lwork = -1;
3178       S = NULL;
3179       St = NULL;
3180       eigs = NULL;
3181       eigv = NULL;
3182       B_iwork = NULL;
3183       B_ifail = NULL;
3184 #if defined(PETSC_USE_COMPLEX)
3185       rwork = NULL;
3186 #endif
3187       thresh = 1.0;
3188       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3189 #if defined(PETSC_USE_COMPLEX)
3190       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));
3191 #else
3192       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));
3193 #endif
3194       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3195       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3196     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3197   } else {
3198     lwork = 0;
3199   }
3200 
3201   nv = 0;
3202   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) */
3203     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3204   }
3205   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3206   if (allocated_S_St) {
3207     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3208   }
3209   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3210 #if defined(PETSC_USE_COMPLEX)
3211   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3212 #endif
3213   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3214                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3215                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3216                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3217                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3218   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3219 
3220   maxneigs = 0;
3221   cum = cumarray = 0;
3222   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3223   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3224   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3225     const PetscInt *idxs;
3226 
3227     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3228     for (cum=0;cum<nv;cum++) {
3229       pcbddc->adaptive_constraints_n[cum] = 1;
3230       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3231       pcbddc->adaptive_constraints_data[cum] = 1.0;
3232       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3233       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3234     }
3235     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3236   }
3237 
3238   if (mss) { /* multilevel */
3239     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3240     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3241   }
3242 
3243   lthresh = pcbddc->adaptive_threshold[0];
3244   uthresh = pcbddc->adaptive_threshold[1];
3245   for (i=0;i<sub_schurs->n_subs;i++) {
3246     const PetscInt *idxs;
3247     PetscReal      upper,lower;
3248     PetscInt       j,subset_size,eigs_start = 0;
3249     PetscBLASInt   B_N;
3250     PetscBool      same_data = PETSC_FALSE;
3251     PetscBool      scal = PETSC_FALSE;
3252 
3253     if (pcbddc->use_deluxe_scaling) {
3254       upper = PETSC_MAX_REAL;
3255       lower = uthresh;
3256     } else {
3257       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3258       upper = 1./uthresh;
3259       lower = 0.;
3260     }
3261     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3262     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3263     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3264     /* this is experimental: we assume the dofs have been properly grouped to have
3265        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3266     if (!sub_schurs->is_posdef) {
3267       Mat T;
3268 
3269       for (j=0;j<subset_size;j++) {
3270         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3271           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3272           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3273           ierr = MatDestroy(&T);CHKERRQ(ierr);
3274           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3275           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3276           ierr = MatDestroy(&T);CHKERRQ(ierr);
3277           if (sub_schurs->change_primal_sub) {
3278             PetscInt       nz,k;
3279             const PetscInt *idxs;
3280 
3281             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3282             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3283             for (k=0;k<nz;k++) {
3284               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3285               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3286             }
3287             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3288           }
3289           scal = PETSC_TRUE;
3290           break;
3291         }
3292       }
3293     }
3294 
3295     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3296       if (sub_schurs->is_symmetric) {
3297         PetscInt j,k;
3298         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3299           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3300           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3301         }
3302         for (j=0;j<subset_size;j++) {
3303           for (k=j;k<subset_size;k++) {
3304             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3305             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3306           }
3307         }
3308       } else {
3309         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3310         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3311       }
3312     } else {
3313       S = Sarray + cumarray;
3314       St = Starray + cumarray;
3315     }
3316     /* see if we can save some work */
3317     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3318       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3319     }
3320 
3321     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3322       B_neigs = 0;
3323     } else {
3324       if (sub_schurs->is_symmetric) {
3325         PetscBLASInt B_itype = 1;
3326         PetscBLASInt B_IL, B_IU;
3327         PetscReal    eps = -1.0; /* dlamch? */
3328         PetscInt     nmin_s;
3329         PetscBool    compute_range;
3330 
3331         B_neigs = 0;
3332         compute_range = (PetscBool)!same_data;
3333         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3334 
3335         if (pcbddc->dbg_flag) {
3336           PetscInt nc = 0;
3337 
3338           if (sub_schurs->change_primal_sub) {
3339             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3340           }
3341           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);
3342         }
3343 
3344         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3345         if (compute_range) {
3346 
3347           /* ask for eigenvalues larger than thresh */
3348           if (sub_schurs->is_posdef) {
3349 #if defined(PETSC_USE_COMPLEX)
3350             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));
3351 #else
3352             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));
3353 #endif
3354             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3355           } else { /* no theory so far, but it works nicely */
3356             PetscInt  recipe = 0,recipe_m = 1;
3357             PetscReal bb[2];
3358 
3359             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3360             switch (recipe) {
3361             case 0:
3362               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3363               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3364 #if defined(PETSC_USE_COMPLEX)
3365               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));
3366 #else
3367               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));
3368 #endif
3369               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3370               break;
3371             case 1:
3372               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3373 #if defined(PETSC_USE_COMPLEX)
3374               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));
3375 #else
3376               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));
3377 #endif
3378               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3379               if (!scal) {
3380                 PetscBLASInt B_neigs2 = 0;
3381 
3382                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3383                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3384                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3385 #if defined(PETSC_USE_COMPLEX)
3386                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3387 #else
3388                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3389 #endif
3390                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3391                 B_neigs += B_neigs2;
3392               }
3393               break;
3394             case 2:
3395               if (scal) {
3396                 bb[0] = PETSC_MIN_REAL;
3397                 bb[1] = 0;
3398 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3400 #else
3401                 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));
3402 #endif
3403                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3404               } else {
3405                 PetscBLASInt B_neigs2 = 0;
3406                 PetscBool    import = PETSC_FALSE;
3407 
3408                 lthresh = PetscMax(lthresh,0.0);
3409                 if (lthresh > 0.0) {
3410                   bb[0] = PETSC_MIN_REAL;
3411                   bb[1] = lthresh*lthresh;
3412 
3413                   import = PETSC_TRUE;
3414 #if defined(PETSC_USE_COMPLEX)
3415                   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));
3416 #else
3417                   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));
3418 #endif
3419                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3420                 }
3421                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3422                 bb[1] = PETSC_MAX_REAL;
3423                 if (import) {
3424                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3425                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3426                 }
3427 #if defined(PETSC_USE_COMPLEX)
3428                 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));
3429 #else
3430                 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));
3431 #endif
3432                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3433                 B_neigs += B_neigs2;
3434               }
3435               break;
3436             case 3:
3437               if (scal) {
3438                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3439               } else {
3440                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3441               }
3442               if (!scal) {
3443                 bb[0] = uthresh;
3444                 bb[1] = PETSC_MAX_REAL;
3445 #if defined(PETSC_USE_COMPLEX)
3446                 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));
3447 #else
3448                 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));
3449 #endif
3450                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3451               }
3452               if (recipe_m > 0 && B_N - B_neigs > 0) {
3453                 PetscBLASInt B_neigs2 = 0;
3454 
3455                 B_IL = 1;
3456                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3457                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3458                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3459 #if defined(PETSC_USE_COMPLEX)
3460                 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));
3461 #else
3462                 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));
3463 #endif
3464                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3465                 B_neigs += B_neigs2;
3466               }
3467               break;
3468             case 4:
3469               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3470 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3472 #else
3473               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));
3474 #endif
3475               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3476               {
3477                 PetscBLASInt B_neigs2 = 0;
3478 
3479                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3480                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3481                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3482 #if defined(PETSC_USE_COMPLEX)
3483                 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));
3484 #else
3485                 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));
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 5: /* same as before: first compute all eigenvalues, then filter */
3492 #if defined(PETSC_USE_COMPLEX)
3493               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));
3494 #else
3495               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));
3496 #endif
3497               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3498               {
3499                 PetscInt e,k,ne;
3500                 for (e=0,ne=0;e<B_neigs;e++) {
3501                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3502                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3503                     eigs[ne] = eigs[e];
3504                     ne++;
3505                   }
3506                 }
3507                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3508                 B_neigs = ne;
3509               }
3510               break;
3511             default:
3512               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3513               break;
3514             }
3515           }
3516         } else if (!same_data) { /* this is just to see all the eigenvalues */
3517           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3518           B_IL = 1;
3519 #if defined(PETSC_USE_COMPLEX)
3520           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));
3521 #else
3522           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));
3523 #endif
3524           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3525         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3526           PetscInt k;
3527           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3528           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3529           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3530           nmin = nmax;
3531           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3532           for (k=0;k<nmax;k++) {
3533             eigs[k] = 1./PETSC_SMALL;
3534             eigv[k*(subset_size+1)] = 1.0;
3535           }
3536         }
3537         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3538         if (B_ierr) {
3539           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3540           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);
3541           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);
3542         }
3543 
3544         if (B_neigs > nmax) {
3545           if (pcbddc->dbg_flag) {
3546             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3547           }
3548           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3549           B_neigs = nmax;
3550         }
3551 
3552         nmin_s = PetscMin(nmin,B_N);
3553         if (B_neigs < nmin_s) {
3554           PetscBLASInt B_neigs2 = 0;
3555 
3556           if (pcbddc->use_deluxe_scaling) {
3557             if (scal) {
3558               B_IU = nmin_s;
3559               B_IL = B_neigs + 1;
3560             } else {
3561               B_IL = B_N - nmin_s + 1;
3562               B_IU = B_N - B_neigs;
3563             }
3564           } else {
3565             B_IL = B_neigs + 1;
3566             B_IU = nmin_s;
3567           }
3568           if (pcbddc->dbg_flag) {
3569             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);
3570           }
3571           if (sub_schurs->is_symmetric) {
3572             PetscInt j,k;
3573             for (j=0;j<subset_size;j++) {
3574               for (k=j;k<subset_size;k++) {
3575                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3576                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3577               }
3578             }
3579           } else {
3580             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3581             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3582           }
3583           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3584 #if defined(PETSC_USE_COMPLEX)
3585           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));
3586 #else
3587           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));
3588 #endif
3589           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3590           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3591           B_neigs += B_neigs2;
3592         }
3593         if (B_ierr) {
3594           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3595           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);
3596           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);
3597         }
3598         if (pcbddc->dbg_flag) {
3599           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3600           for (j=0;j<B_neigs;j++) {
3601             if (eigs[j] == 0.0) {
3602               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3603             } else {
3604               if (pcbddc->use_deluxe_scaling) {
3605                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3606               } else {
3607                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3608               }
3609             }
3610           }
3611         }
3612       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3613     }
3614     /* change the basis back to the original one */
3615     if (sub_schurs->change) {
3616       Mat change,phi,phit;
3617 
3618       if (pcbddc->dbg_flag > 2) {
3619         PetscInt ii;
3620         for (ii=0;ii<B_neigs;ii++) {
3621           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3622           for (j=0;j<B_N;j++) {
3623 #if defined(PETSC_USE_COMPLEX)
3624             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3625             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3626             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3627 #else
3628             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3629 #endif
3630           }
3631         }
3632       }
3633       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3634       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3635       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3636       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3637       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3638       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3639     }
3640     maxneigs = PetscMax(B_neigs,maxneigs);
3641     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3642     if (B_neigs) {
3643       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3644 
3645       if (pcbddc->dbg_flag > 1) {
3646         PetscInt ii;
3647         for (ii=0;ii<B_neigs;ii++) {
3648           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3649           for (j=0;j<B_N;j++) {
3650 #if defined(PETSC_USE_COMPLEX)
3651             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3652             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3653             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3654 #else
3655             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3656 #endif
3657           }
3658         }
3659       }
3660       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3661       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3662       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3663       cum++;
3664     }
3665     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3666     /* shift for next computation */
3667     cumarray += subset_size*subset_size;
3668   }
3669   if (pcbddc->dbg_flag) {
3670     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3671   }
3672 
3673   if (mss) {
3674     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3675     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3676     /* destroy matrices (junk) */
3677     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3678     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3679   }
3680   if (allocated_S_St) {
3681     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3682   }
3683   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3684 #if defined(PETSC_USE_COMPLEX)
3685   ierr = PetscFree(rwork);CHKERRQ(ierr);
3686 #endif
3687   if (pcbddc->dbg_flag) {
3688     PetscInt maxneigs_r;
3689     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3690     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3691   }
3692   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3693   PetscFunctionReturn(0);
3694 }
3695 
3696 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3697 {
3698   PetscScalar    *coarse_submat_vals;
3699   PetscErrorCode ierr;
3700 
3701   PetscFunctionBegin;
3702   /* Setup local scatters R_to_B and (optionally) R_to_D */
3703   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3704   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3705 
3706   /* Setup local neumann solver ksp_R */
3707   /* PCBDDCSetUpLocalScatters should be called first! */
3708   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3709 
3710   /*
3711      Setup local correction and local part of coarse basis.
3712      Gives back the dense local part of the coarse matrix in column major ordering
3713   */
3714   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3715 
3716   /* Compute total number of coarse nodes and setup coarse solver */
3717   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3718 
3719   /* free */
3720   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3721   PetscFunctionReturn(0);
3722 }
3723 
3724 PetscErrorCode PCBDDCResetCustomization(PC pc)
3725 {
3726   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3727   PetscErrorCode ierr;
3728 
3729   PetscFunctionBegin;
3730   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3731   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3732   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3733   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3734   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3735   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3736   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3737   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3738   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3739   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3740   PetscFunctionReturn(0);
3741 }
3742 
3743 PetscErrorCode PCBDDCResetTopography(PC pc)
3744 {
3745   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3746   PetscInt       i;
3747   PetscErrorCode ierr;
3748 
3749   PetscFunctionBegin;
3750   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3751   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3752   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3753   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3754   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3755   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3756   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3757   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3758   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3759   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3760   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3761   for (i=0;i<pcbddc->n_local_subs;i++) {
3762     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3763   }
3764   pcbddc->n_local_subs = 0;
3765   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3766   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3767   pcbddc->graphanalyzed        = PETSC_FALSE;
3768   pcbddc->recompute_topography = PETSC_TRUE;
3769   pcbddc->corner_selected      = PETSC_FALSE;
3770   PetscFunctionReturn(0);
3771 }
3772 
3773 PetscErrorCode PCBDDCResetSolvers(PC pc)
3774 {
3775   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3776   PetscErrorCode ierr;
3777 
3778   PetscFunctionBegin;
3779   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3780   if (pcbddc->coarse_phi_B) {
3781     PetscScalar *array;
3782     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3783     ierr = PetscFree(array);CHKERRQ(ierr);
3784   }
3785   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3786   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3787   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3788   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3789   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3790   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3791   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3792   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3793   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3794   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3795   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3796   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3797   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3798   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3799   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3800   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3801   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3802   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3803   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3804   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3805   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3806   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3807   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3809   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3810   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3811   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3812   if (pcbddc->benign_zerodiag_subs) {
3813     PetscInt i;
3814     for (i=0;i<pcbddc->benign_n;i++) {
3815       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3816     }
3817     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3818   }
3819   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3820   PetscFunctionReturn(0);
3821 }
3822 
3823 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3824 {
3825   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3826   PC_IS          *pcis = (PC_IS*)pc->data;
3827   VecType        impVecType;
3828   PetscInt       n_constraints,n_R,old_size;
3829   PetscErrorCode ierr;
3830 
3831   PetscFunctionBegin;
3832   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3833   n_R = pcis->n - pcbddc->n_vertices;
3834   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3835   /* local work vectors (try to avoid unneeded work)*/
3836   /* R nodes */
3837   old_size = -1;
3838   if (pcbddc->vec1_R) {
3839     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3840   }
3841   if (n_R != old_size) {
3842     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3843     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3844     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3845     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3846     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3847     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3848   }
3849   /* local primal dofs */
3850   old_size = -1;
3851   if (pcbddc->vec1_P) {
3852     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3853   }
3854   if (pcbddc->local_primal_size != old_size) {
3855     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3856     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3857     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3858     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3859   }
3860   /* local explicit constraints */
3861   old_size = -1;
3862   if (pcbddc->vec1_C) {
3863     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3864   }
3865   if (n_constraints && n_constraints != old_size) {
3866     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3867     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3868     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3869     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3870   }
3871   PetscFunctionReturn(0);
3872 }
3873 
3874 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3875 {
3876   PetscErrorCode  ierr;
3877   /* pointers to pcis and pcbddc */
3878   PC_IS*          pcis = (PC_IS*)pc->data;
3879   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3880   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3881   /* submatrices of local problem */
3882   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3883   /* submatrices of local coarse problem */
3884   Mat             S_VV,S_CV,S_VC,S_CC;
3885   /* working matrices */
3886   Mat             C_CR;
3887   /* additional working stuff */
3888   PC              pc_R;
3889   Mat             F,Brhs = NULL;
3890   Vec             dummy_vec;
3891   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3892   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3893   PetscScalar     *work;
3894   PetscInt        *idx_V_B;
3895   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3896   PetscInt        i,n_R,n_D,n_B;
3897 
3898   /* some shortcuts to scalars */
3899   PetscScalar     one=1.0,m_one=-1.0;
3900 
3901   PetscFunctionBegin;
3902   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");
3903   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3904 
3905   /* Set Non-overlapping dimensions */
3906   n_vertices = pcbddc->n_vertices;
3907   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3908   n_B = pcis->n_B;
3909   n_D = pcis->n - n_B;
3910   n_R = pcis->n - n_vertices;
3911 
3912   /* vertices in boundary numbering */
3913   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3914   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3915   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3916 
3917   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3918   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3919   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3920   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3921   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3922   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3923   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3924   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3925   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3926   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3927 
3928   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3929   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3930   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3931   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3932   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3933   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3934   lda_rhs = n_R;
3935   need_benign_correction = PETSC_FALSE;
3936   if (isLU || isILU || isCHOL) {
3937     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3938   } else if (sub_schurs && sub_schurs->reuse_solver) {
3939     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3940     MatFactorType      type;
3941 
3942     F = reuse_solver->F;
3943     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3944     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3945     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3946     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3947   } else {
3948     F = NULL;
3949   }
3950 
3951   /* determine if we can use a sparse right-hand side */
3952   sparserhs = PETSC_FALSE;
3953   if (F) {
3954     MatSolverType solver;
3955 
3956     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3957     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3958   }
3959 
3960   /* allocate workspace */
3961   n = 0;
3962   if (n_constraints) {
3963     n += lda_rhs*n_constraints;
3964   }
3965   if (n_vertices) {
3966     n = PetscMax(2*lda_rhs*n_vertices,n);
3967     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3968   }
3969   if (!pcbddc->symmetric_primal) {
3970     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3971   }
3972   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3973 
3974   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3975   dummy_vec = NULL;
3976   if (need_benign_correction && lda_rhs != n_R && F) {
3977     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3978     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3979     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3980   }
3981 
3982   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3983   if (n_constraints) {
3984     Mat         M3,C_B;
3985     IS          is_aux;
3986     PetscScalar *array,*array2;
3987 
3988     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3989     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3990 
3991     /* Extract constraints on R nodes: C_{CR}  */
3992     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3993     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3994     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3995 
3996     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3997     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3998     if (!sparserhs) {
3999       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
4000       for (i=0;i<n_constraints;i++) {
4001         const PetscScalar *row_cmat_values;
4002         const PetscInt    *row_cmat_indices;
4003         PetscInt          size_of_constraint,j;
4004 
4005         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4006         for (j=0;j<size_of_constraint;j++) {
4007           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4008         }
4009         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4010       }
4011       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4012     } else {
4013       Mat tC_CR;
4014 
4015       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4016       if (lda_rhs != n_R) {
4017         PetscScalar *aa;
4018         PetscInt    r,*ii,*jj;
4019         PetscBool   done;
4020 
4021         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4022         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4023         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4024         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4025         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4026         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4027       } else {
4028         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4029         tC_CR = C_CR;
4030       }
4031       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4032       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4033     }
4034     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4035     if (F) {
4036       if (need_benign_correction) {
4037         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4038 
4039         /* rhs is already zero on interior dofs, no need to change the rhs */
4040         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
4041       }
4042       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4043       if (need_benign_correction) {
4044         PetscScalar        *marr;
4045         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4046 
4047         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4048         if (lda_rhs != n_R) {
4049           for (i=0;i<n_constraints;i++) {
4050             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4051             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4052             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4053           }
4054         } else {
4055           for (i=0;i<n_constraints;i++) {
4056             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4057             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4058             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4059           }
4060         }
4061         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4062       }
4063     } else {
4064       PetscScalar *marr;
4065 
4066       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4067       for (i=0;i<n_constraints;i++) {
4068         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4069         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4070         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4071         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4072         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4073         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4074       }
4075       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4076     }
4077     if (sparserhs) {
4078       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4079     }
4080     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4081     if (!pcbddc->switch_static) {
4082       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4083       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4084       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4085       for (i=0;i<n_constraints;i++) {
4086         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4087         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4088         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4089         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4090         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4091         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4092       }
4093       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4094       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4095       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4096     } else {
4097       if (lda_rhs != n_R) {
4098         IS dummy;
4099 
4100         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4101         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4102         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4103       } else {
4104         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4105         pcbddc->local_auxmat2 = local_auxmat2_R;
4106       }
4107       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4108     }
4109     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4110     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4111     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4112     if (isCHOL) {
4113       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4114     } else {
4115       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4116     }
4117     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4118     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4119     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4120     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4121     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4122     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4123   }
4124 
4125   /* Get submatrices from subdomain matrix */
4126   if (n_vertices) {
4127     IS        is_aux;
4128     PetscBool isseqaij;
4129 
4130     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4131       IS tis;
4132 
4133       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4134       ierr = ISSort(tis);CHKERRQ(ierr);
4135       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4136       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4137     } else {
4138       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4139     }
4140     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4141     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4142     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4143     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4144       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4145     }
4146     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4147     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4148   }
4149 
4150   /* Matrix of coarse basis functions (local) */
4151   if (pcbddc->coarse_phi_B) {
4152     PetscInt on_B,on_primal,on_D=n_D;
4153     if (pcbddc->coarse_phi_D) {
4154       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4155     }
4156     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4157     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4158       PetscScalar *marray;
4159 
4160       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4161       ierr = PetscFree(marray);CHKERRQ(ierr);
4162       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4163       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4164       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4165       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4166     }
4167   }
4168 
4169   if (!pcbddc->coarse_phi_B) {
4170     PetscScalar *marr;
4171 
4172     /* memory size */
4173     n = n_B*pcbddc->local_primal_size;
4174     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4175     if (!pcbddc->symmetric_primal) n *= 2;
4176     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4177     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4178     marr += n_B*pcbddc->local_primal_size;
4179     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4180       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4181       marr += n_D*pcbddc->local_primal_size;
4182     }
4183     if (!pcbddc->symmetric_primal) {
4184       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4185       marr += n_B*pcbddc->local_primal_size;
4186       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4187         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4188       }
4189     } else {
4190       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4191       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4192       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4193         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4194         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4195       }
4196     }
4197   }
4198 
4199   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4200   p0_lidx_I = NULL;
4201   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4202     const PetscInt *idxs;
4203 
4204     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4205     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4206     for (i=0;i<pcbddc->benign_n;i++) {
4207       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4208     }
4209     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4210   }
4211 
4212   /* vertices */
4213   if (n_vertices) {
4214     PetscBool restoreavr = PETSC_FALSE;
4215 
4216     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4217 
4218     if (n_R) {
4219       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4220       PetscBLASInt B_N,B_one = 1;
4221       PetscScalar  *x,*y;
4222 
4223       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4224       if (need_benign_correction) {
4225         ISLocalToGlobalMapping RtoN;
4226         IS                     is_p0;
4227         PetscInt               *idxs_p0,n;
4228 
4229         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4230         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4231         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4232         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);
4233         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4234         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4235         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4236         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4237       }
4238 
4239       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4240       if (!sparserhs || need_benign_correction) {
4241         if (lda_rhs == n_R) {
4242           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4243         } else {
4244           PetscScalar    *av,*array;
4245           const PetscInt *xadj,*adjncy;
4246           PetscInt       n;
4247           PetscBool      flg_row;
4248 
4249           array = work+lda_rhs*n_vertices;
4250           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4251           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4252           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4253           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4254           for (i=0;i<n;i++) {
4255             PetscInt j;
4256             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4257           }
4258           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4259           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4260           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4261         }
4262         if (need_benign_correction) {
4263           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4264           PetscScalar        *marr;
4265 
4266           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4267           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4268 
4269                  | 0 0  0 | (V)
4270              L = | 0 0 -1 | (P-p0)
4271                  | 0 0 -1 | (p0)
4272 
4273           */
4274           for (i=0;i<reuse_solver->benign_n;i++) {
4275             const PetscScalar *vals;
4276             const PetscInt    *idxs,*idxs_zero;
4277             PetscInt          n,j,nz;
4278 
4279             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4280             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4281             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4282             for (j=0;j<n;j++) {
4283               PetscScalar val = vals[j];
4284               PetscInt    k,col = idxs[j];
4285               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4286             }
4287             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4288             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4289           }
4290           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4291         }
4292         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4293         Brhs = A_RV;
4294       } else {
4295         Mat tA_RVT,A_RVT;
4296 
4297         if (!pcbddc->symmetric_primal) {
4298           /* A_RV already scaled by -1 */
4299           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4300         } else {
4301           restoreavr = PETSC_TRUE;
4302           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4303           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4304           A_RVT = A_VR;
4305         }
4306         if (lda_rhs != n_R) {
4307           PetscScalar *aa;
4308           PetscInt    r,*ii,*jj;
4309           PetscBool   done;
4310 
4311           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4312           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4313           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4314           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4315           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4316           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4317         } else {
4318           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4319           tA_RVT = A_RVT;
4320         }
4321         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4322         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4323         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4324       }
4325       if (F) {
4326         /* need to correct the rhs */
4327         if (need_benign_correction) {
4328           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4329           PetscScalar        *marr;
4330 
4331           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4332           if (lda_rhs != n_R) {
4333             for (i=0;i<n_vertices;i++) {
4334               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4335               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4336               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4337             }
4338           } else {
4339             for (i=0;i<n_vertices;i++) {
4340               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4341               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4342               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4343             }
4344           }
4345           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4346         }
4347         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4348         if (restoreavr) {
4349           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4350         }
4351         /* need to correct the solution */
4352         if (need_benign_correction) {
4353           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4354           PetscScalar        *marr;
4355 
4356           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4357           if (lda_rhs != n_R) {
4358             for (i=0;i<n_vertices;i++) {
4359               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4360               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4361               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4362             }
4363           } else {
4364             for (i=0;i<n_vertices;i++) {
4365               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4366               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4367               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4368             }
4369           }
4370           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4371         }
4372       } else {
4373         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4374         for (i=0;i<n_vertices;i++) {
4375           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4376           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4377           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4378           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4379           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4380           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4381         }
4382         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4383       }
4384       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4385       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4386       /* S_VV and S_CV */
4387       if (n_constraints) {
4388         Mat B;
4389 
4390         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4391         for (i=0;i<n_vertices;i++) {
4392           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4393           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4394           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4395           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4396           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4397           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4398         }
4399         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4400         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4401         ierr = MatDestroy(&B);CHKERRQ(ierr);
4402         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4403         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4404         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4405         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4406         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4407         ierr = MatDestroy(&B);CHKERRQ(ierr);
4408       }
4409       if (lda_rhs != n_R) {
4410         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4411         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4412         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4413       }
4414       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4415       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4416       if (need_benign_correction) {
4417         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4418         PetscScalar      *marr,*sums;
4419 
4420         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4421         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4422         for (i=0;i<reuse_solver->benign_n;i++) {
4423           const PetscScalar *vals;
4424           const PetscInt    *idxs,*idxs_zero;
4425           PetscInt          n,j,nz;
4426 
4427           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4428           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4429           for (j=0;j<n_vertices;j++) {
4430             PetscInt k;
4431             sums[j] = 0.;
4432             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4433           }
4434           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4435           for (j=0;j<n;j++) {
4436             PetscScalar val = vals[j];
4437             PetscInt k;
4438             for (k=0;k<n_vertices;k++) {
4439               marr[idxs[j]+k*n_vertices] += val*sums[k];
4440             }
4441           }
4442           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4443           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4444         }
4445         ierr = PetscFree(sums);CHKERRQ(ierr);
4446         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4447         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4448       }
4449       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4450       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4451       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4452       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4453       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4454       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4455       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4456       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4457       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4458     } else {
4459       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4460     }
4461     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4462 
4463     /* coarse basis functions */
4464     for (i=0;i<n_vertices;i++) {
4465       PetscScalar *y;
4466 
4467       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4468       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4469       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4470       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4471       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4472       y[n_B*i+idx_V_B[i]] = 1.0;
4473       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4474       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4475 
4476       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4477         PetscInt j;
4478 
4479         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4480         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4481         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4482         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4483         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4484         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4485         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4486       }
4487       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4488     }
4489     /* if n_R == 0 the object is not destroyed */
4490     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4491   }
4492   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4493 
4494   if (n_constraints) {
4495     Mat B;
4496 
4497     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4498     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4499     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4500     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4501     if (n_vertices) {
4502       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4503         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4504       } else {
4505         Mat S_VCt;
4506 
4507         if (lda_rhs != n_R) {
4508           ierr = MatDestroy(&B);CHKERRQ(ierr);
4509           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4510           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4511         }
4512         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4513         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4514         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4515       }
4516     }
4517     ierr = MatDestroy(&B);CHKERRQ(ierr);
4518     /* coarse basis functions */
4519     for (i=0;i<n_constraints;i++) {
4520       PetscScalar *y;
4521 
4522       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4523       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4524       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4525       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4526       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4527       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4528       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4529       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4530         PetscInt j;
4531 
4532         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4533         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4534         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4535         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4536         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4537         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4538         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4539       }
4540       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4541     }
4542   }
4543   if (n_constraints) {
4544     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4545   }
4546   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4547 
4548   /* coarse matrix entries relative to B_0 */
4549   if (pcbddc->benign_n) {
4550     Mat         B0_B,B0_BPHI;
4551     IS          is_dummy;
4552     PetscScalar *data;
4553     PetscInt    j;
4554 
4555     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4556     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4557     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4558     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4559     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4560     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4561     for (j=0;j<pcbddc->benign_n;j++) {
4562       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4563       for (i=0;i<pcbddc->local_primal_size;i++) {
4564         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4565         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4566       }
4567     }
4568     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4569     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4570     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4571   }
4572 
4573   /* compute other basis functions for non-symmetric problems */
4574   if (!pcbddc->symmetric_primal) {
4575     Mat         B_V=NULL,B_C=NULL;
4576     PetscScalar *marray;
4577 
4578     if (n_constraints) {
4579       Mat S_CCT,C_CRT;
4580 
4581       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4582       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4583       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4584       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4585       if (n_vertices) {
4586         Mat S_VCT;
4587 
4588         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4589         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4590         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4591       }
4592       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4593     } else {
4594       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4595     }
4596     if (n_vertices && n_R) {
4597       PetscScalar    *av,*marray;
4598       const PetscInt *xadj,*adjncy;
4599       PetscInt       n;
4600       PetscBool      flg_row;
4601 
4602       /* B_V = B_V - A_VR^T */
4603       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4604       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4605       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4606       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4607       for (i=0;i<n;i++) {
4608         PetscInt j;
4609         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4610       }
4611       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4612       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4613       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4614     }
4615 
4616     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4617     if (n_vertices) {
4618       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4619       for (i=0;i<n_vertices;i++) {
4620         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4621         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4622         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4623         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4624         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4625         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4626       }
4627       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4628     }
4629     if (B_C) {
4630       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4631       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4632         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4633         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4634         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4635         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4636         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4637         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4638       }
4639       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4640     }
4641     /* coarse basis functions */
4642     for (i=0;i<pcbddc->local_primal_size;i++) {
4643       PetscScalar *y;
4644 
4645       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4646       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4647       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4648       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4649       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4650       if (i<n_vertices) {
4651         y[n_B*i+idx_V_B[i]] = 1.0;
4652       }
4653       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4654       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4655 
4656       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4657         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4658         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4659         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4660         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4661         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4662         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4663       }
4664       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4665     }
4666     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4667     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4668   }
4669 
4670   /* free memory */
4671   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4672   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4673   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4674   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4675   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4676   ierr = PetscFree(work);CHKERRQ(ierr);
4677   if (n_vertices) {
4678     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4679   }
4680   if (n_constraints) {
4681     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4682   }
4683   /* Checking coarse_sub_mat and coarse basis functios */
4684   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4685   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4686   if (pcbddc->dbg_flag) {
4687     Mat         coarse_sub_mat;
4688     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4689     Mat         coarse_phi_D,coarse_phi_B;
4690     Mat         coarse_psi_D,coarse_psi_B;
4691     Mat         A_II,A_BB,A_IB,A_BI;
4692     Mat         C_B,CPHI;
4693     IS          is_dummy;
4694     Vec         mones;
4695     MatType     checkmattype=MATSEQAIJ;
4696     PetscReal   real_value;
4697 
4698     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4699       Mat A;
4700       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4701       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4702       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4703       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4704       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4705       ierr = MatDestroy(&A);CHKERRQ(ierr);
4706     } else {
4707       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4708       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4709       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4710       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4711     }
4712     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4713     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4714     if (!pcbddc->symmetric_primal) {
4715       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4716       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4717     }
4718     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4719 
4720     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4721     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4722     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4723     if (!pcbddc->symmetric_primal) {
4724       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4725       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4726       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4727       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4728       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4729       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4730       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4731       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4732       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4733       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4734       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4735       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4736     } else {
4737       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4738       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4739       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4740       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4741       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4742       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4743       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4744       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4745     }
4746     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4747     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4748     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4749     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4750     if (pcbddc->benign_n) {
4751       Mat         B0_B,B0_BPHI;
4752       PetscScalar *data,*data2;
4753       PetscInt    j;
4754 
4755       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4756       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4757       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4758       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4759       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4760       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4761       for (j=0;j<pcbddc->benign_n;j++) {
4762         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4763         for (i=0;i<pcbddc->local_primal_size;i++) {
4764           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4765           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4766         }
4767       }
4768       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4769       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4770       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4771       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4772       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4773     }
4774 #if 0
4775   {
4776     PetscViewer viewer;
4777     char filename[256];
4778     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4779     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4780     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4781     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4782     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4783     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4784     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4785     if (pcbddc->coarse_phi_B) {
4786       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4787       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4788     }
4789     if (pcbddc->coarse_phi_D) {
4790       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4791       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4792     }
4793     if (pcbddc->coarse_psi_B) {
4794       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4795       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4796     }
4797     if (pcbddc->coarse_psi_D) {
4798       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4799       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4800     }
4801     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4802     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4803     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4804     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4805     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4806     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4807     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4808     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4809     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4810     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4811     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4812   }
4813 #endif
4814     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4815     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4816     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4817     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4818 
4819     /* check constraints */
4820     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4821     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4822     if (!pcbddc->benign_n) { /* TODO: add benign case */
4823       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4824     } else {
4825       PetscScalar *data;
4826       Mat         tmat;
4827       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4828       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4829       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4830       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4831       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4832     }
4833     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4834     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4835     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4836     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4837     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4838     if (!pcbddc->symmetric_primal) {
4839       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4840       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4841       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4842       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4843       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4844     }
4845     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4846     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4847     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4848     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4849     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4850     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4851     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4852     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4853     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4854     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4855     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4856     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4857     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4858     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4859     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4860     if (!pcbddc->symmetric_primal) {
4861       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4862       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4863     }
4864     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4865   }
4866   /* get back data */
4867   *coarse_submat_vals_n = coarse_submat_vals;
4868   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4869   PetscFunctionReturn(0);
4870 }
4871 
4872 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4873 {
4874   Mat            *work_mat;
4875   IS             isrow_s,iscol_s;
4876   PetscBool      rsorted,csorted;
4877   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4878   PetscErrorCode ierr;
4879 
4880   PetscFunctionBegin;
4881   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4882   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4883   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4884   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4885 
4886   if (!rsorted) {
4887     const PetscInt *idxs;
4888     PetscInt *idxs_sorted,i;
4889 
4890     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4891     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4892     for (i=0;i<rsize;i++) {
4893       idxs_perm_r[i] = i;
4894     }
4895     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4896     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4897     for (i=0;i<rsize;i++) {
4898       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4899     }
4900     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4901     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4902   } else {
4903     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4904     isrow_s = isrow;
4905   }
4906 
4907   if (!csorted) {
4908     if (isrow == iscol) {
4909       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4910       iscol_s = isrow_s;
4911     } else {
4912       const PetscInt *idxs;
4913       PetscInt       *idxs_sorted,i;
4914 
4915       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4916       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4917       for (i=0;i<csize;i++) {
4918         idxs_perm_c[i] = i;
4919       }
4920       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4921       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4922       for (i=0;i<csize;i++) {
4923         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4924       }
4925       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4926       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4927     }
4928   } else {
4929     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4930     iscol_s = iscol;
4931   }
4932 
4933   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4934 
4935   if (!rsorted || !csorted) {
4936     Mat      new_mat;
4937     IS       is_perm_r,is_perm_c;
4938 
4939     if (!rsorted) {
4940       PetscInt *idxs_r,i;
4941       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4942       for (i=0;i<rsize;i++) {
4943         idxs_r[idxs_perm_r[i]] = i;
4944       }
4945       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4946       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4947     } else {
4948       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4949     }
4950     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4951 
4952     if (!csorted) {
4953       if (isrow_s == iscol_s) {
4954         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4955         is_perm_c = is_perm_r;
4956       } else {
4957         PetscInt *idxs_c,i;
4958         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4959         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4960         for (i=0;i<csize;i++) {
4961           idxs_c[idxs_perm_c[i]] = i;
4962         }
4963         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4964         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4965       }
4966     } else {
4967       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4968     }
4969     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4970 
4971     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4972     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4973     work_mat[0] = new_mat;
4974     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4975     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4976   }
4977 
4978   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4979   *B = work_mat[0];
4980   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4981   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4982   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4983   PetscFunctionReturn(0);
4984 }
4985 
4986 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4987 {
4988   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4989   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4990   Mat            new_mat,lA;
4991   IS             is_local,is_global;
4992   PetscInt       local_size;
4993   PetscBool      isseqaij;
4994   PetscErrorCode ierr;
4995 
4996   PetscFunctionBegin;
4997   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4998   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4999   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5000   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5001   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5002   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5003   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5004 
5005   /* check */
5006   if (pcbddc->dbg_flag) {
5007     Vec       x,x_change;
5008     PetscReal error;
5009 
5010     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5011     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5012     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5013     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5014     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5015     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5016     if (!pcbddc->change_interior) {
5017       const PetscScalar *x,*y,*v;
5018       PetscReal         lerror = 0.;
5019       PetscInt          i;
5020 
5021       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5022       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5023       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5024       for (i=0;i<local_size;i++)
5025         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5026           lerror = PetscAbsScalar(x[i]-y[i]);
5027       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5028       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5029       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5030       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5031       if (error > PETSC_SMALL) {
5032         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5033           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5034         } else {
5035           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5036         }
5037       }
5038     }
5039     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5040     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5041     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5042     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5043     if (error > PETSC_SMALL) {
5044       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5045         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5046       } else {
5047         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5048       }
5049     }
5050     ierr = VecDestroy(&x);CHKERRQ(ierr);
5051     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5052   }
5053 
5054   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5055   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5056 
5057   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5058   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5059   if (isseqaij) {
5060     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5061     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5062     if (lA) {
5063       Mat work;
5064       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5065       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5066       ierr = MatDestroy(&work);CHKERRQ(ierr);
5067     }
5068   } else {
5069     Mat work_mat;
5070 
5071     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5072     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5073     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5074     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5075     if (lA) {
5076       Mat work;
5077       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5078       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5079       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5080       ierr = MatDestroy(&work);CHKERRQ(ierr);
5081     }
5082   }
5083   if (matis->A->symmetric_set) {
5084     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5085 #if !defined(PETSC_USE_COMPLEX)
5086     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5087 #endif
5088   }
5089   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5090   PetscFunctionReturn(0);
5091 }
5092 
5093 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5094 {
5095   PC_IS*          pcis = (PC_IS*)(pc->data);
5096   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5097   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5098   PetscInt        *idx_R_local=NULL;
5099   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5100   PetscInt        vbs,bs;
5101   PetscBT         bitmask=NULL;
5102   PetscErrorCode  ierr;
5103 
5104   PetscFunctionBegin;
5105   /*
5106     No need to setup local scatters if
5107       - primal space is unchanged
5108         AND
5109       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5110         AND
5111       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5112   */
5113   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5114     PetscFunctionReturn(0);
5115   }
5116   /* destroy old objects */
5117   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5118   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5119   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5120   /* Set Non-overlapping dimensions */
5121   n_B = pcis->n_B;
5122   n_D = pcis->n - n_B;
5123   n_vertices = pcbddc->n_vertices;
5124 
5125   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5126 
5127   /* create auxiliary bitmask and allocate workspace */
5128   if (!sub_schurs || !sub_schurs->reuse_solver) {
5129     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5130     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5131     for (i=0;i<n_vertices;i++) {
5132       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5133     }
5134 
5135     for (i=0, n_R=0; i<pcis->n; i++) {
5136       if (!PetscBTLookup(bitmask,i)) {
5137         idx_R_local[n_R++] = i;
5138       }
5139     }
5140   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5141     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5142 
5143     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5144     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5145   }
5146 
5147   /* Block code */
5148   vbs = 1;
5149   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5150   if (bs>1 && !(n_vertices%bs)) {
5151     PetscBool is_blocked = PETSC_TRUE;
5152     PetscInt  *vary;
5153     if (!sub_schurs || !sub_schurs->reuse_solver) {
5154       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5155       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5156       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5157       /* 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 */
5158       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5159       for (i=0; i<pcis->n/bs; i++) {
5160         if (vary[i]!=0 && vary[i]!=bs) {
5161           is_blocked = PETSC_FALSE;
5162           break;
5163         }
5164       }
5165       ierr = PetscFree(vary);CHKERRQ(ierr);
5166     } else {
5167       /* Verify directly the R set */
5168       for (i=0; i<n_R/bs; i++) {
5169         PetscInt j,node=idx_R_local[bs*i];
5170         for (j=1; j<bs; j++) {
5171           if (node != idx_R_local[bs*i+j]-j) {
5172             is_blocked = PETSC_FALSE;
5173             break;
5174           }
5175         }
5176       }
5177     }
5178     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5179       vbs = bs;
5180       for (i=0;i<n_R/vbs;i++) {
5181         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5182       }
5183     }
5184   }
5185   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5186   if (sub_schurs && sub_schurs->reuse_solver) {
5187     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5188 
5189     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5190     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5191     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5192     reuse_solver->is_R = pcbddc->is_R_local;
5193   } else {
5194     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5195   }
5196 
5197   /* print some info if requested */
5198   if (pcbddc->dbg_flag) {
5199     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5200     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5201     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5202     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5203     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5204     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);
5205     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5206   }
5207 
5208   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5209   if (!sub_schurs || !sub_schurs->reuse_solver) {
5210     IS       is_aux1,is_aux2;
5211     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5212 
5213     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5214     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5215     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5216     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5217     for (i=0; i<n_D; i++) {
5218       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5219     }
5220     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5221     for (i=0, j=0; i<n_R; i++) {
5222       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5223         aux_array1[j++] = i;
5224       }
5225     }
5226     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5227     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5228     for (i=0, j=0; i<n_B; i++) {
5229       if (!PetscBTLookup(bitmask,is_indices[i])) {
5230         aux_array2[j++] = i;
5231       }
5232     }
5233     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5234     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5235     ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5236     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5237     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5238 
5239     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5240       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5241       for (i=0, j=0; i<n_R; i++) {
5242         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5243           aux_array1[j++] = i;
5244         }
5245       }
5246       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5247       ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5248       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5249     }
5250     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5251     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5252   } else {
5253     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5254     IS                 tis;
5255     PetscInt           schur_size;
5256 
5257     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5258     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5259     ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5260     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5261     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5262       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5263       ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5264       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5265     }
5266   }
5267   PetscFunctionReturn(0);
5268 }
5269 
5270 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B)
5271 {
5272   MatNullSpace   NullSpace;
5273   Mat            dmat;
5274   const Vec      *nullvecs;
5275   Vec            v,v2,*nullvecs2;
5276   VecScatter     sct;
5277   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5278   PetscBool      nnsp_has_cnst;
5279   PetscErrorCode ierr;
5280 
5281   PetscFunctionBegin;
5282   ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5283   if (!NullSpace) {
5284     ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5285   }
5286   if (NullSpace) PetscFunctionReturn(0);
5287   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5288   if (!NullSpace) {
5289     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5290   }
5291   if (!NullSpace) PetscFunctionReturn(0);
5292   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5293   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5294   ierr = VecScatterCreateWithData(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5295   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5296   bsiz = nnsp_size+!!nnsp_has_cnst;
5297   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5298   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5299   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5300   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5301   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5302   for (k=0;k<nnsp_size;k++) {
5303     PetscScalar *arr;
5304 
5305     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5306     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5307     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5308     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5309     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5310   }
5311   if (nnsp_has_cnst) {
5312     PetscScalar *arr;
5313 
5314     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5315     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5316     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5317     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5318   }
5319   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5320   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5321   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5322   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5323   for (k=0;k<bsiz;k++) {
5324     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5325   }
5326   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5327   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5328   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5329   ierr = VecDestroy(&v);CHKERRQ(ierr);
5330   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5331   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5332   PetscFunctionReturn(0);
5333 }
5334 
5335 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5336 {
5337   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5338   PC_IS          *pcis = (PC_IS*)pc->data;
5339   PC             pc_temp;
5340   Mat            A_RR;
5341   MatNullSpace   nnsp;
5342   MatReuse       reuse;
5343   PetscScalar    m_one = -1.0;
5344   PetscReal      value;
5345   PetscInt       n_D,n_R;
5346   PetscBool      issbaij,opts;
5347   PetscErrorCode ierr;
5348   void           (*f)(void) = 0;
5349   char           dir_prefix[256],neu_prefix[256],str_level[16];
5350   size_t         len;
5351 
5352   PetscFunctionBegin;
5353   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5354   /* compute prefixes */
5355   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5356   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5357   if (!pcbddc->current_level) {
5358     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5359     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5360     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5361     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5362   } else {
5363     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5364     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5365     len -= 15; /* remove "pc_bddc_coarse_" */
5366     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5367     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5368     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5369     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5370     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5371     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5372     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5373     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5374     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5375   }
5376 
5377   /* DIRICHLET PROBLEM */
5378   if (dirichlet) {
5379     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5380     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5381       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5382       if (pcbddc->dbg_flag) {
5383         Mat    A_IIn;
5384 
5385         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5386         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5387         pcis->A_II = A_IIn;
5388       }
5389     }
5390     if (pcbddc->local_mat->symmetric_set) {
5391       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5392     }
5393     /* Matrix for Dirichlet problem is pcis->A_II */
5394     n_D  = pcis->n - pcis->n_B;
5395     opts = PETSC_FALSE;
5396     if (!pcbddc->ksp_D) { /* create object if not yet build */
5397       opts = PETSC_TRUE;
5398       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5399       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5400       /* default */
5401       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5402       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5403       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5404       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5405       if (issbaij) {
5406         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5407       } else {
5408         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5409       }
5410       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5411     }
5412     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5413     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5414     /* Allow user's customization */
5415     if (opts) {
5416       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5417     }
5418     if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */
5419       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5420     }
5421     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5422     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5423     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5424     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5425       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5426       const PetscInt *idxs;
5427       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5428 
5429       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5430       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5431       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5432       for (i=0;i<nl;i++) {
5433         for (d=0;d<cdim;d++) {
5434           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5435         }
5436       }
5437       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5438       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5439       ierr = PetscFree(scoords);CHKERRQ(ierr);
5440     }
5441     if (sub_schurs && sub_schurs->reuse_solver) {
5442       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5443 
5444       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5445     }
5446 
5447     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5448     if (!n_D) {
5449       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5450       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5451     }
5452     /* set ksp_D into pcis data */
5453     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5454     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5455     pcis->ksp_D = pcbddc->ksp_D;
5456   }
5457 
5458   /* NEUMANN PROBLEM */
5459   A_RR = 0;
5460   if (neumann) {
5461     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5462     PetscInt        ibs,mbs;
5463     PetscBool       issbaij, reuse_neumann_solver;
5464     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5465 
5466     reuse_neumann_solver = PETSC_FALSE;
5467     if (sub_schurs && sub_schurs->reuse_solver) {
5468       IS iP;
5469 
5470       reuse_neumann_solver = PETSC_TRUE;
5471       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5472       if (iP) reuse_neumann_solver = PETSC_FALSE;
5473     }
5474     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5475     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5476     if (pcbddc->ksp_R) { /* already created ksp */
5477       PetscInt nn_R;
5478       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5479       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5480       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5481       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5482         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5483         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5484         reuse = MAT_INITIAL_MATRIX;
5485       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5486         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5487           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5488           reuse = MAT_INITIAL_MATRIX;
5489         } else { /* safe to reuse the matrix */
5490           reuse = MAT_REUSE_MATRIX;
5491         }
5492       }
5493       /* last check */
5494       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5495         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5496         reuse = MAT_INITIAL_MATRIX;
5497       }
5498     } else { /* first time, so we need to create the matrix */
5499       reuse = MAT_INITIAL_MATRIX;
5500     }
5501     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5502     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5503     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5504     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5505     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5506       if (matis->A == pcbddc->local_mat) {
5507         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5508         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5509       } else {
5510         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5511       }
5512     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5513       if (matis->A == pcbddc->local_mat) {
5514         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5515         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5516       } else {
5517         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5518       }
5519     }
5520     /* extract A_RR */
5521     if (reuse_neumann_solver) {
5522       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5523 
5524       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5525         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5526         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5527           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5528         } else {
5529           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5530         }
5531       } else {
5532         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5533         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5534         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5535       }
5536     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5537       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5538     }
5539     if (pcbddc->local_mat->symmetric_set) {
5540       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5541     }
5542     opts = PETSC_FALSE;
5543     if (!pcbddc->ksp_R) { /* create object if not present */
5544       opts = PETSC_TRUE;
5545       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5546       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5547       /* default */
5548       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5549       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5550       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5551       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5552       if (issbaij) {
5553         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5554       } else {
5555         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5556       }
5557       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5558     }
5559     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5560     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5561     if (opts) { /* Allow user's customization once */
5562       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5563     }
5564     if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */
5565       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5566     }
5567     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5568     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5569     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5570     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5571       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5572       const PetscInt *idxs;
5573       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5574 
5575       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5576       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5577       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5578       for (i=0;i<nl;i++) {
5579         for (d=0;d<cdim;d++) {
5580           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5581         }
5582       }
5583       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5584       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5585       ierr = PetscFree(scoords);CHKERRQ(ierr);
5586     }
5587 
5588     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5589     if (!n_R) {
5590       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5591       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5592     }
5593     /* Reuse solver if it is present */
5594     if (reuse_neumann_solver) {
5595       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5596 
5597       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5598     }
5599   }
5600 
5601   if (pcbddc->dbg_flag) {
5602     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5603     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5604     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5605   }
5606 
5607   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5608   if (pcbddc->NullSpace_corr[0]) {
5609     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5610   }
5611   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5612     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5613   }
5614   if (neumann && pcbddc->NullSpace_corr[2]) {
5615     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5616   }
5617   /* check Dirichlet and Neumann solvers */
5618   if (pcbddc->dbg_flag) {
5619     if (dirichlet) { /* Dirichlet */
5620       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5621       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5622       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5623       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5624       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5625       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5626       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);
5627       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5628     }
5629     if (neumann) { /* Neumann */
5630       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5631       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5632       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5633       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5634       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5635       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5636       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);
5637       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5638     }
5639   }
5640   /* free Neumann problem's matrix */
5641   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5642   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5643   PetscFunctionReturn(0);
5644 }
5645 
5646 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5647 {
5648   PetscErrorCode  ierr;
5649   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5650   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5651   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5652 
5653   PetscFunctionBegin;
5654   if (!reuse_solver) {
5655     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5656   }
5657   if (!pcbddc->switch_static) {
5658     if (applytranspose && pcbddc->local_auxmat1) {
5659       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5660       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5661     }
5662     if (!reuse_solver) {
5663       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5664       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5665     } else {
5666       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5667 
5668       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5669       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5670     }
5671   } else {
5672     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5673     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5674     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5675     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5676     if (applytranspose && pcbddc->local_auxmat1) {
5677       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5678       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5679       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5680       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5681     }
5682   }
5683   if (!reuse_solver || pcbddc->switch_static) {
5684     if (applytranspose) {
5685       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5686     } else {
5687       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5688     }
5689     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5690   } else {
5691     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5692 
5693     if (applytranspose) {
5694       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5695     } else {
5696       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5697     }
5698   }
5699   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5700   if (!pcbddc->switch_static) {
5701     if (!reuse_solver) {
5702       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5703       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5704     } else {
5705       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5706 
5707       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5708       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5709     }
5710     if (!applytranspose && pcbddc->local_auxmat1) {
5711       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5712       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5713     }
5714   } else {
5715     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5716     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5717     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5718     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5719     if (!applytranspose && pcbddc->local_auxmat1) {
5720       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5721       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5722     }
5723     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5724     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5725     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5726     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5727   }
5728   PetscFunctionReturn(0);
5729 }
5730 
5731 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5732 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5733 {
5734   PetscErrorCode ierr;
5735   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5736   PC_IS*            pcis = (PC_IS*)  (pc->data);
5737   const PetscScalar zero = 0.0;
5738 
5739   PetscFunctionBegin;
5740   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5741   if (!pcbddc->benign_apply_coarse_only) {
5742     if (applytranspose) {
5743       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5744       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5745     } else {
5746       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5747       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5748     }
5749   } else {
5750     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5751   }
5752 
5753   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5754   if (pcbddc->benign_n) {
5755     PetscScalar *array;
5756     PetscInt    j;
5757 
5758     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5759     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5760     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5761   }
5762 
5763   /* start communications from local primal nodes to rhs of coarse solver */
5764   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5765   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5766   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5767 
5768   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5769   if (pcbddc->coarse_ksp) {
5770     Mat          coarse_mat;
5771     Vec          rhs,sol;
5772     MatNullSpace nullsp;
5773     PetscBool    isbddc = PETSC_FALSE;
5774 
5775     if (pcbddc->benign_have_null) {
5776       PC        coarse_pc;
5777 
5778       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5779       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5780       /* we need to propagate to coarser levels the need for a possible benign correction */
5781       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5782         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5783         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5784         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5785       }
5786     }
5787     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5788     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5789     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5790     if (applytranspose) {
5791       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5792       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5793       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5794       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5795       if (nullsp) {
5796         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5797       }
5798     } else {
5799       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5800       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5801         PC        coarse_pc;
5802 
5803         if (nullsp) {
5804           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5805         }
5806         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5807         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5808         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5809         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5810       } else {
5811         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5812         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5813         if (nullsp) {
5814           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5815         }
5816       }
5817     }
5818     /* we don't need the benign correction at coarser levels anymore */
5819     if (pcbddc->benign_have_null && isbddc) {
5820       PC        coarse_pc;
5821       PC_BDDC*  coarsepcbddc;
5822 
5823       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5824       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5825       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5826       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5827     }
5828   }
5829 
5830   /* Local solution on R nodes */
5831   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5832     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5833   }
5834   /* communications from coarse sol to local primal nodes */
5835   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5836   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5837 
5838   /* Sum contributions from the two levels */
5839   if (!pcbddc->benign_apply_coarse_only) {
5840     if (applytranspose) {
5841       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5842       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5843     } else {
5844       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5845       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5846     }
5847     /* store p0 */
5848     if (pcbddc->benign_n) {
5849       PetscScalar *array;
5850       PetscInt    j;
5851 
5852       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5853       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5854       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5855     }
5856   } else { /* expand the coarse solution */
5857     if (applytranspose) {
5858       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5859     } else {
5860       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5861     }
5862   }
5863   PetscFunctionReturn(0);
5864 }
5865 
5866 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5867 {
5868   PetscErrorCode ierr;
5869   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5870   PetscScalar    *array;
5871   Vec            from,to;
5872 
5873   PetscFunctionBegin;
5874   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5875     from = pcbddc->coarse_vec;
5876     to = pcbddc->vec1_P;
5877     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5878       Vec tvec;
5879 
5880       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5881       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5882       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5883       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5884       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5885       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5886     }
5887   } else { /* from local to global -> put data in coarse right hand side */
5888     from = pcbddc->vec1_P;
5889     to = pcbddc->coarse_vec;
5890   }
5891   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5892   PetscFunctionReturn(0);
5893 }
5894 
5895 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5896 {
5897   PetscErrorCode ierr;
5898   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5899   PetscScalar    *array;
5900   Vec            from,to;
5901 
5902   PetscFunctionBegin;
5903   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5904     from = pcbddc->coarse_vec;
5905     to = pcbddc->vec1_P;
5906   } else { /* from local to global -> put data in coarse right hand side */
5907     from = pcbddc->vec1_P;
5908     to = pcbddc->coarse_vec;
5909   }
5910   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5911   if (smode == SCATTER_FORWARD) {
5912     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5913       Vec tvec;
5914 
5915       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5916       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5917       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5918       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5919     }
5920   } else {
5921     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5922      ierr = VecResetArray(from);CHKERRQ(ierr);
5923     }
5924   }
5925   PetscFunctionReturn(0);
5926 }
5927 
5928 /* uncomment for testing purposes */
5929 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5930 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5931 {
5932   PetscErrorCode    ierr;
5933   PC_IS*            pcis = (PC_IS*)(pc->data);
5934   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5935   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5936   /* one and zero */
5937   PetscScalar       one=1.0,zero=0.0;
5938   /* space to store constraints and their local indices */
5939   PetscScalar       *constraints_data;
5940   PetscInt          *constraints_idxs,*constraints_idxs_B;
5941   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5942   PetscInt          *constraints_n;
5943   /* iterators */
5944   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5945   /* BLAS integers */
5946   PetscBLASInt      lwork,lierr;
5947   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5948   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5949   /* reuse */
5950   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5951   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5952   /* change of basis */
5953   PetscBool         qr_needed;
5954   PetscBT           change_basis,qr_needed_idx;
5955   /* auxiliary stuff */
5956   PetscInt          *nnz,*is_indices;
5957   PetscInt          ncc;
5958   /* some quantities */
5959   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5960   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5961   PetscReal         tol; /* tolerance for retaining eigenmodes */
5962 
5963   PetscFunctionBegin;
5964   tol  = PetscSqrtReal(PETSC_SMALL);
5965   /* Destroy Mat objects computed previously */
5966   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5967   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5968   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5969   /* save info on constraints from previous setup (if any) */
5970   olocal_primal_size = pcbddc->local_primal_size;
5971   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5972   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5973   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5974   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5975   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5976   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5977 
5978   if (!pcbddc->adaptive_selection) {
5979     IS           ISForVertices,*ISForFaces,*ISForEdges;
5980     MatNullSpace nearnullsp;
5981     const Vec    *nearnullvecs;
5982     Vec          *localnearnullsp;
5983     PetscScalar  *array;
5984     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5985     PetscBool    nnsp_has_cnst;
5986     /* LAPACK working arrays for SVD or POD */
5987     PetscBool    skip_lapack,boolforchange;
5988     PetscScalar  *work;
5989     PetscReal    *singular_vals;
5990 #if defined(PETSC_USE_COMPLEX)
5991     PetscReal    *rwork;
5992 #endif
5993 #if defined(PETSC_MISSING_LAPACK_GESVD)
5994     PetscScalar  *temp_basis,*correlation_mat;
5995 #else
5996     PetscBLASInt dummy_int=1;
5997     PetscScalar  dummy_scalar=1.;
5998 #endif
5999 
6000     /* Get index sets for faces, edges and vertices from graph */
6001     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6002     /* print some info */
6003     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6004       PetscInt nv;
6005 
6006       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6007       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6008       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6009       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6010       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6011       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6012       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6013       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6014       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6015     }
6016 
6017     /* free unneeded index sets */
6018     if (!pcbddc->use_vertices) {
6019       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6020     }
6021     if (!pcbddc->use_edges) {
6022       for (i=0;i<n_ISForEdges;i++) {
6023         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6024       }
6025       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6026       n_ISForEdges = 0;
6027     }
6028     if (!pcbddc->use_faces) {
6029       for (i=0;i<n_ISForFaces;i++) {
6030         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6031       }
6032       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6033       n_ISForFaces = 0;
6034     }
6035 
6036     /* check if near null space is attached to global mat */
6037     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6038     if (nearnullsp) {
6039       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6040       /* remove any stored info */
6041       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6042       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6043       /* store information for BDDC solver reuse */
6044       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6045       pcbddc->onearnullspace = nearnullsp;
6046       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6047       for (i=0;i<nnsp_size;i++) {
6048         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6049       }
6050     } else { /* if near null space is not provided BDDC uses constants by default */
6051       nnsp_size = 0;
6052       nnsp_has_cnst = PETSC_TRUE;
6053     }
6054     /* get max number of constraints on a single cc */
6055     max_constraints = nnsp_size;
6056     if (nnsp_has_cnst) max_constraints++;
6057 
6058     /*
6059          Evaluate maximum storage size needed by the procedure
6060          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6061          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6062          There can be multiple constraints per connected component
6063                                                                                                                                                            */
6064     n_vertices = 0;
6065     if (ISForVertices) {
6066       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6067     }
6068     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6069     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6070 
6071     total_counts = n_ISForFaces+n_ISForEdges;
6072     total_counts *= max_constraints;
6073     total_counts += n_vertices;
6074     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6075 
6076     total_counts = 0;
6077     max_size_of_constraint = 0;
6078     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6079       IS used_is;
6080       if (i<n_ISForEdges) {
6081         used_is = ISForEdges[i];
6082       } else {
6083         used_is = ISForFaces[i-n_ISForEdges];
6084       }
6085       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6086       total_counts += j;
6087       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6088     }
6089     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);
6090 
6091     /* get local part of global near null space vectors */
6092     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6093     for (k=0;k<nnsp_size;k++) {
6094       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6095       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6096       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6097     }
6098 
6099     /* whether or not to skip lapack calls */
6100     skip_lapack = PETSC_TRUE;
6101     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6102 
6103     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6104     if (!skip_lapack) {
6105       PetscScalar temp_work;
6106 
6107 #if defined(PETSC_MISSING_LAPACK_GESVD)
6108       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6109       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6110       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6111       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6112 #if defined(PETSC_USE_COMPLEX)
6113       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6114 #endif
6115       /* now we evaluate the optimal workspace using query with lwork=-1 */
6116       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6117       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6118       lwork = -1;
6119       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6120 #if !defined(PETSC_USE_COMPLEX)
6121       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6122 #else
6123       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6124 #endif
6125       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6126       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6127 #else /* on missing GESVD */
6128       /* SVD */
6129       PetscInt max_n,min_n;
6130       max_n = max_size_of_constraint;
6131       min_n = max_constraints;
6132       if (max_size_of_constraint < max_constraints) {
6133         min_n = max_size_of_constraint;
6134         max_n = max_constraints;
6135       }
6136       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6137 #if defined(PETSC_USE_COMPLEX)
6138       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6139 #endif
6140       /* now we evaluate the optimal workspace using query with lwork=-1 */
6141       lwork = -1;
6142       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6143       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6144       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6145       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6146 #if !defined(PETSC_USE_COMPLEX)
6147       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));
6148 #else
6149       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));
6150 #endif
6151       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6152       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6153 #endif /* on missing GESVD */
6154       /* Allocate optimal workspace */
6155       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6156       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6157     }
6158     /* Now we can loop on constraining sets */
6159     total_counts = 0;
6160     constraints_idxs_ptr[0] = 0;
6161     constraints_data_ptr[0] = 0;
6162     /* vertices */
6163     if (n_vertices) {
6164       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6165       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6166       for (i=0;i<n_vertices;i++) {
6167         constraints_n[total_counts] = 1;
6168         constraints_data[total_counts] = 1.0;
6169         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6170         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6171         total_counts++;
6172       }
6173       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6174       n_vertices = total_counts;
6175     }
6176 
6177     /* edges and faces */
6178     total_counts_cc = total_counts;
6179     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6180       IS        used_is;
6181       PetscBool idxs_copied = PETSC_FALSE;
6182 
6183       if (ncc<n_ISForEdges) {
6184         used_is = ISForEdges[ncc];
6185         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6186       } else {
6187         used_is = ISForFaces[ncc-n_ISForEdges];
6188         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6189       }
6190       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6191 
6192       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6193       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6194       /* change of basis should not be performed on local periodic nodes */
6195       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6196       if (nnsp_has_cnst) {
6197         PetscScalar quad_value;
6198 
6199         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6200         idxs_copied = PETSC_TRUE;
6201 
6202         if (!pcbddc->use_nnsp_true) {
6203           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6204         } else {
6205           quad_value = 1.0;
6206         }
6207         for (j=0;j<size_of_constraint;j++) {
6208           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6209         }
6210         temp_constraints++;
6211         total_counts++;
6212       }
6213       for (k=0;k<nnsp_size;k++) {
6214         PetscReal real_value;
6215         PetscScalar *ptr_to_data;
6216 
6217         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6218         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6219         for (j=0;j<size_of_constraint;j++) {
6220           ptr_to_data[j] = array[is_indices[j]];
6221         }
6222         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6223         /* check if array is null on the connected component */
6224         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6225         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6226         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6227           temp_constraints++;
6228           total_counts++;
6229           if (!idxs_copied) {
6230             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6231             idxs_copied = PETSC_TRUE;
6232           }
6233         }
6234       }
6235       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6236       valid_constraints = temp_constraints;
6237       if (!pcbddc->use_nnsp_true && temp_constraints) {
6238         if (temp_constraints == 1) { /* just normalize the constraint */
6239           PetscScalar norm,*ptr_to_data;
6240 
6241           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6242           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6243           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6244           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6245           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6246         } else { /* perform SVD */
6247           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6248 
6249 #if defined(PETSC_MISSING_LAPACK_GESVD)
6250           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6251              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6252              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6253                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6254                 from that computed using LAPACKgesvd
6255              -> This is due to a different computation of eigenvectors in LAPACKheev
6256              -> The quality of the POD-computed basis will be the same */
6257           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6258           /* Store upper triangular part of correlation matrix */
6259           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6260           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6261           for (j=0;j<temp_constraints;j++) {
6262             for (k=0;k<j+1;k++) {
6263               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));
6264             }
6265           }
6266           /* compute eigenvalues and eigenvectors of correlation matrix */
6267           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6268           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6269 #if !defined(PETSC_USE_COMPLEX)
6270           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6271 #else
6272           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6273 #endif
6274           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6275           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6276           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6277           j = 0;
6278           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6279           total_counts = total_counts-j;
6280           valid_constraints = temp_constraints-j;
6281           /* scale and copy POD basis into used quadrature memory */
6282           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6283           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6284           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6285           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6286           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6287           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6288           if (j<temp_constraints) {
6289             PetscInt ii;
6290             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6291             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6292             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));
6293             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6294             for (k=0;k<temp_constraints-j;k++) {
6295               for (ii=0;ii<size_of_constraint;ii++) {
6296                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6297               }
6298             }
6299           }
6300 #else  /* on missing GESVD */
6301           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6302           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6303           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6304           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6305 #if !defined(PETSC_USE_COMPLEX)
6306           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));
6307 #else
6308           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));
6309 #endif
6310           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6311           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6312           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6313           k = temp_constraints;
6314           if (k > size_of_constraint) k = size_of_constraint;
6315           j = 0;
6316           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6317           valid_constraints = k-j;
6318           total_counts = total_counts-temp_constraints+valid_constraints;
6319 #endif /* on missing GESVD */
6320         }
6321       }
6322       /* update pointers information */
6323       if (valid_constraints) {
6324         constraints_n[total_counts_cc] = valid_constraints;
6325         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6326         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6327         /* set change_of_basis flag */
6328         if (boolforchange) {
6329           PetscBTSet(change_basis,total_counts_cc);
6330         }
6331         total_counts_cc++;
6332       }
6333     }
6334     /* free workspace */
6335     if (!skip_lapack) {
6336       ierr = PetscFree(work);CHKERRQ(ierr);
6337 #if defined(PETSC_USE_COMPLEX)
6338       ierr = PetscFree(rwork);CHKERRQ(ierr);
6339 #endif
6340       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6341 #if defined(PETSC_MISSING_LAPACK_GESVD)
6342       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6343       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6344 #endif
6345     }
6346     for (k=0;k<nnsp_size;k++) {
6347       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6348     }
6349     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6350     /* free index sets of faces, edges and vertices */
6351     for (i=0;i<n_ISForFaces;i++) {
6352       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6353     }
6354     if (n_ISForFaces) {
6355       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6356     }
6357     for (i=0;i<n_ISForEdges;i++) {
6358       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6359     }
6360     if (n_ISForEdges) {
6361       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6362     }
6363     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6364   } else {
6365     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6366 
6367     total_counts = 0;
6368     n_vertices = 0;
6369     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6370       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6371     }
6372     max_constraints = 0;
6373     total_counts_cc = 0;
6374     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6375       total_counts += pcbddc->adaptive_constraints_n[i];
6376       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6377       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6378     }
6379     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6380     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6381     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6382     constraints_data = pcbddc->adaptive_constraints_data;
6383     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6384     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6385     total_counts_cc = 0;
6386     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6387       if (pcbddc->adaptive_constraints_n[i]) {
6388         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6389       }
6390     }
6391 
6392     max_size_of_constraint = 0;
6393     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]);
6394     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6395     /* Change of basis */
6396     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6397     if (pcbddc->use_change_of_basis) {
6398       for (i=0;i<sub_schurs->n_subs;i++) {
6399         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6400           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6401         }
6402       }
6403     }
6404   }
6405   pcbddc->local_primal_size = total_counts;
6406   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6407 
6408   /* map constraints_idxs in boundary numbering */
6409   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6410   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);
6411 
6412   /* Create constraint matrix */
6413   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6414   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6415   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6416 
6417   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6418   /* determine if a QR strategy is needed for change of basis */
6419   qr_needed = pcbddc->use_qr_single;
6420   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6421   total_primal_vertices=0;
6422   pcbddc->local_primal_size_cc = 0;
6423   for (i=0;i<total_counts_cc;i++) {
6424     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6425     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6426       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6427       pcbddc->local_primal_size_cc += 1;
6428     } else if (PetscBTLookup(change_basis,i)) {
6429       for (k=0;k<constraints_n[i];k++) {
6430         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6431       }
6432       pcbddc->local_primal_size_cc += constraints_n[i];
6433       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6434         PetscBTSet(qr_needed_idx,i);
6435         qr_needed = PETSC_TRUE;
6436       }
6437     } else {
6438       pcbddc->local_primal_size_cc += 1;
6439     }
6440   }
6441   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6442   pcbddc->n_vertices = total_primal_vertices;
6443   /* permute indices in order to have a sorted set of vertices */
6444   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6445   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);
6446   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6447   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6448 
6449   /* nonzero structure of constraint matrix */
6450   /* and get reference dof for local constraints */
6451   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6452   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6453 
6454   j = total_primal_vertices;
6455   total_counts = total_primal_vertices;
6456   cum = total_primal_vertices;
6457   for (i=n_vertices;i<total_counts_cc;i++) {
6458     if (!PetscBTLookup(change_basis,i)) {
6459       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6460       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6461       cum++;
6462       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6463       for (k=0;k<constraints_n[i];k++) {
6464         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6465         nnz[j+k] = size_of_constraint;
6466       }
6467       j += constraints_n[i];
6468     }
6469   }
6470   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6471   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6472   ierr = PetscFree(nnz);CHKERRQ(ierr);
6473 
6474   /* set values in constraint matrix */
6475   for (i=0;i<total_primal_vertices;i++) {
6476     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6477   }
6478   total_counts = total_primal_vertices;
6479   for (i=n_vertices;i<total_counts_cc;i++) {
6480     if (!PetscBTLookup(change_basis,i)) {
6481       PetscInt *cols;
6482 
6483       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6484       cols = constraints_idxs+constraints_idxs_ptr[i];
6485       for (k=0;k<constraints_n[i];k++) {
6486         PetscInt    row = total_counts+k;
6487         PetscScalar *vals;
6488 
6489         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6490         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6491       }
6492       total_counts += constraints_n[i];
6493     }
6494   }
6495   /* assembling */
6496   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6497   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6498   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6499 
6500   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6501   if (pcbddc->use_change_of_basis) {
6502     /* dual and primal dofs on a single cc */
6503     PetscInt     dual_dofs,primal_dofs;
6504     /* working stuff for GEQRF */
6505     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6506     PetscBLASInt lqr_work;
6507     /* working stuff for UNGQR */
6508     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6509     PetscBLASInt lgqr_work;
6510     /* working stuff for TRTRS */
6511     PetscScalar  *trs_rhs = NULL;
6512     PetscBLASInt Blas_NRHS;
6513     /* pointers for values insertion into change of basis matrix */
6514     PetscInt     *start_rows,*start_cols;
6515     PetscScalar  *start_vals;
6516     /* working stuff for values insertion */
6517     PetscBT      is_primal;
6518     PetscInt     *aux_primal_numbering_B;
6519     /* matrix sizes */
6520     PetscInt     global_size,local_size;
6521     /* temporary change of basis */
6522     Mat          localChangeOfBasisMatrix;
6523     /* extra space for debugging */
6524     PetscScalar  *dbg_work = NULL;
6525 
6526     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6527     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6528     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6529     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6530     /* nonzeros for local mat */
6531     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6532     if (!pcbddc->benign_change || pcbddc->fake_change) {
6533       for (i=0;i<pcis->n;i++) nnz[i]=1;
6534     } else {
6535       const PetscInt *ii;
6536       PetscInt       n;
6537       PetscBool      flg_row;
6538       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6539       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6540       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6541     }
6542     for (i=n_vertices;i<total_counts_cc;i++) {
6543       if (PetscBTLookup(change_basis,i)) {
6544         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6545         if (PetscBTLookup(qr_needed_idx,i)) {
6546           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6547         } else {
6548           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6549           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6550         }
6551       }
6552     }
6553     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6554     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6555     ierr = PetscFree(nnz);CHKERRQ(ierr);
6556     /* Set interior change in the matrix */
6557     if (!pcbddc->benign_change || pcbddc->fake_change) {
6558       for (i=0;i<pcis->n;i++) {
6559         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6560       }
6561     } else {
6562       const PetscInt *ii,*jj;
6563       PetscScalar    *aa;
6564       PetscInt       n;
6565       PetscBool      flg_row;
6566       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6567       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6568       for (i=0;i<n;i++) {
6569         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6570       }
6571       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6572       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6573     }
6574 
6575     if (pcbddc->dbg_flag) {
6576       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6577       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6578     }
6579 
6580 
6581     /* Now we loop on the constraints which need a change of basis */
6582     /*
6583        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6584        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6585 
6586        Basic blocks of change of basis matrix T computed by
6587 
6588           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6589 
6590             | 1        0   ...        0         s_1/S |
6591             | 0        1   ...        0         s_2/S |
6592             |              ...                        |
6593             | 0        ...            1     s_{n-1}/S |
6594             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6595 
6596             with S = \sum_{i=1}^n s_i^2
6597             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6598                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6599 
6600           - QR decomposition of constraints otherwise
6601     */
6602     if (qr_needed && max_size_of_constraint) {
6603       /* space to store Q */
6604       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6605       /* array to store scaling factors for reflectors */
6606       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6607       /* first we issue queries for optimal work */
6608       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6609       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6610       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6611       lqr_work = -1;
6612       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6613       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6614       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6615       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6616       lgqr_work = -1;
6617       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6618       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6619       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6620       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6621       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6622       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6623       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6624       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6625       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6626       /* array to store rhs and solution of triangular solver */
6627       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6628       /* allocating workspace for check */
6629       if (pcbddc->dbg_flag) {
6630         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6631       }
6632     }
6633     /* array to store whether a node is primal or not */
6634     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6635     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6636     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6637     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);
6638     for (i=0;i<total_primal_vertices;i++) {
6639       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6640     }
6641     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6642 
6643     /* loop on constraints and see whether or not they need a change of basis and compute it */
6644     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6645       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6646       if (PetscBTLookup(change_basis,total_counts)) {
6647         /* get constraint info */
6648         primal_dofs = constraints_n[total_counts];
6649         dual_dofs = size_of_constraint-primal_dofs;
6650 
6651         if (pcbddc->dbg_flag) {
6652           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);
6653         }
6654 
6655         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6656 
6657           /* copy quadrature constraints for change of basis check */
6658           if (pcbddc->dbg_flag) {
6659             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6660           }
6661           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6662           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6663 
6664           /* compute QR decomposition of constraints */
6665           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6666           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6667           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6668           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6669           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6670           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6671           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6672 
6673           /* explictly compute R^-T */
6674           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6675           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6676           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6677           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6678           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6679           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6680           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6681           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6682           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6683           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6684 
6685           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6686           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6687           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6688           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6689           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6690           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6691           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6692           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6693           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6694 
6695           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6696              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6697              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6698           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6699           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6700           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6701           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6702           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6703           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6704           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6705           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));
6706           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6707           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6708 
6709           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6710           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6711           /* insert cols for primal dofs */
6712           for (j=0;j<primal_dofs;j++) {
6713             start_vals = &qr_basis[j*size_of_constraint];
6714             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6715             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6716           }
6717           /* insert cols for dual dofs */
6718           for (j=0,k=0;j<dual_dofs;k++) {
6719             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6720               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6721               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6722               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6723               j++;
6724             }
6725           }
6726 
6727           /* check change of basis */
6728           if (pcbddc->dbg_flag) {
6729             PetscInt   ii,jj;
6730             PetscBool valid_qr=PETSC_TRUE;
6731             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6732             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6733             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6734             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6735             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6736             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6737             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6738             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));
6739             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6740             for (jj=0;jj<size_of_constraint;jj++) {
6741               for (ii=0;ii<primal_dofs;ii++) {
6742                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6743                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6744               }
6745             }
6746             if (!valid_qr) {
6747               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6748               for (jj=0;jj<size_of_constraint;jj++) {
6749                 for (ii=0;ii<primal_dofs;ii++) {
6750                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6751                     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);
6752                   }
6753                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6754                     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);
6755                   }
6756                 }
6757               }
6758             } else {
6759               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6760             }
6761           }
6762         } else { /* simple transformation block */
6763           PetscInt    row,col;
6764           PetscScalar val,norm;
6765 
6766           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6767           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6768           for (j=0;j<size_of_constraint;j++) {
6769             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6770             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6771             if (!PetscBTLookup(is_primal,row_B)) {
6772               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6773               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6774               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6775             } else {
6776               for (k=0;k<size_of_constraint;k++) {
6777                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6778                 if (row != col) {
6779                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6780                 } else {
6781                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6782                 }
6783                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6784               }
6785             }
6786           }
6787           if (pcbddc->dbg_flag) {
6788             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6789           }
6790         }
6791       } else {
6792         if (pcbddc->dbg_flag) {
6793           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6794         }
6795       }
6796     }
6797 
6798     /* free workspace */
6799     if (qr_needed) {
6800       if (pcbddc->dbg_flag) {
6801         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6802       }
6803       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6804       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6805       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6806       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6807       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6808     }
6809     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6810     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6811     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6812 
6813     /* assembling of global change of variable */
6814     if (!pcbddc->fake_change) {
6815       Mat      tmat;
6816       PetscInt bs;
6817 
6818       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6819       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6820       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6821       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6822       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6823       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6824       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6825       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6826       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6827       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6828       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6829       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6830       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6831       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6832       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6833       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6834       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6835       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6836       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6837       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6838 
6839       /* check */
6840       if (pcbddc->dbg_flag) {
6841         PetscReal error;
6842         Vec       x,x_change;
6843 
6844         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6845         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6846         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6847         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6848         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6849         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6850         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6851         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6852         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6853         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6854         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6855         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6856         if (error > PETSC_SMALL) {
6857           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6858         }
6859         ierr = VecDestroy(&x);CHKERRQ(ierr);
6860         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6861       }
6862       /* adapt sub_schurs computed (if any) */
6863       if (pcbddc->use_deluxe_scaling) {
6864         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6865 
6866         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");
6867         if (sub_schurs && sub_schurs->S_Ej_all) {
6868           Mat                    S_new,tmat;
6869           IS                     is_all_N,is_V_Sall = NULL;
6870 
6871           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6872           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6873           if (pcbddc->deluxe_zerorows) {
6874             ISLocalToGlobalMapping NtoSall;
6875             IS                     is_V;
6876             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6877             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6878             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6879             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6880             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6881           }
6882           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6883           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6884           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6885           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6886           if (pcbddc->deluxe_zerorows) {
6887             const PetscScalar *array;
6888             const PetscInt    *idxs_V,*idxs_all;
6889             PetscInt          i,n_V;
6890 
6891             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6892             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6893             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6894             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6895             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6896             for (i=0;i<n_V;i++) {
6897               PetscScalar val;
6898               PetscInt    idx;
6899 
6900               idx = idxs_V[i];
6901               val = array[idxs_all[idxs_V[i]]];
6902               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6903             }
6904             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6905             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6906             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6907             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6908             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6909           }
6910           sub_schurs->S_Ej_all = S_new;
6911           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6912           if (sub_schurs->sum_S_Ej_all) {
6913             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6914             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6915             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6916             if (pcbddc->deluxe_zerorows) {
6917               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6918             }
6919             sub_schurs->sum_S_Ej_all = S_new;
6920             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6921           }
6922           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6923           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6924         }
6925         /* destroy any change of basis context in sub_schurs */
6926         if (sub_schurs && sub_schurs->change) {
6927           PetscInt i;
6928 
6929           for (i=0;i<sub_schurs->n_subs;i++) {
6930             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6931           }
6932           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6933         }
6934       }
6935       if (pcbddc->switch_static) { /* need to save the local change */
6936         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6937       } else {
6938         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6939       }
6940       /* determine if any process has changed the pressures locally */
6941       pcbddc->change_interior = pcbddc->benign_have_null;
6942     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6943       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6944       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6945       pcbddc->use_qr_single = qr_needed;
6946     }
6947   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6948     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6949       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6950       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6951     } else {
6952       Mat benign_global = NULL;
6953       if (pcbddc->benign_have_null) {
6954         Mat M;
6955 
6956         pcbddc->change_interior = PETSC_TRUE;
6957         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6958         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6959         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6960         if (pcbddc->benign_change) {
6961           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6962           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6963         } else {
6964           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6965           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6966         }
6967         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6968         ierr = MatDestroy(&M);CHKERRQ(ierr);
6969         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6970         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6971       }
6972       if (pcbddc->user_ChangeOfBasisMatrix) {
6973         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6974         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6975       } else if (pcbddc->benign_have_null) {
6976         pcbddc->ChangeOfBasisMatrix = benign_global;
6977       }
6978     }
6979     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6980       IS             is_global;
6981       const PetscInt *gidxs;
6982 
6983       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6984       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6985       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6986       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6987       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6988     }
6989   }
6990   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6991     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6992   }
6993 
6994   if (!pcbddc->fake_change) {
6995     /* add pressure dofs to set of primal nodes for numbering purposes */
6996     for (i=0;i<pcbddc->benign_n;i++) {
6997       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6998       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6999       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7000       pcbddc->local_primal_size_cc++;
7001       pcbddc->local_primal_size++;
7002     }
7003 
7004     /* check if a new primal space has been introduced (also take into account benign trick) */
7005     pcbddc->new_primal_space_local = PETSC_TRUE;
7006     if (olocal_primal_size == pcbddc->local_primal_size) {
7007       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7008       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7009       if (!pcbddc->new_primal_space_local) {
7010         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7011         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7012       }
7013     }
7014     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7015     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7016   }
7017   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7018 
7019   /* flush dbg viewer */
7020   if (pcbddc->dbg_flag) {
7021     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7022   }
7023 
7024   /* free workspace */
7025   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7026   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7027   if (!pcbddc->adaptive_selection) {
7028     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7029     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7030   } else {
7031     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7032                       pcbddc->adaptive_constraints_idxs_ptr,
7033                       pcbddc->adaptive_constraints_data_ptr,
7034                       pcbddc->adaptive_constraints_idxs,
7035                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7036     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7037     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7038   }
7039   PetscFunctionReturn(0);
7040 }
7041 /* #undef PETSC_MISSING_LAPACK_GESVD */
7042 
7043 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7044 {
7045   ISLocalToGlobalMapping map;
7046   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7047   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7048   PetscInt               i,N;
7049   PetscBool              rcsr = PETSC_FALSE;
7050   PetscErrorCode         ierr;
7051 
7052   PetscFunctionBegin;
7053   if (pcbddc->recompute_topography) {
7054     pcbddc->graphanalyzed = PETSC_FALSE;
7055     /* Reset previously computed graph */
7056     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7057     /* Init local Graph struct */
7058     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7059     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7060     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7061 
7062     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7063       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7064     }
7065     /* Check validity of the csr graph passed in by the user */
7066     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);
7067 
7068     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7069     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7070       PetscInt  *xadj,*adjncy;
7071       PetscInt  nvtxs;
7072       PetscBool flg_row=PETSC_FALSE;
7073 
7074       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7075       if (flg_row) {
7076         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7077         pcbddc->computed_rowadj = PETSC_TRUE;
7078       }
7079       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7080       rcsr = PETSC_TRUE;
7081     }
7082     if (pcbddc->dbg_flag) {
7083       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7084     }
7085 
7086     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7087       PetscReal    *lcoords;
7088       PetscInt     n;
7089       MPI_Datatype dimrealtype;
7090 
7091       /* TODO: support for blocked */
7092       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);
7093       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7094       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7095       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7096       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7097       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7098       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7099       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7100       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7101 
7102       pcbddc->mat_graph->coords = lcoords;
7103       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7104       pcbddc->mat_graph->cnloc  = n;
7105     }
7106     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);
7107     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7108 
7109     /* Setup of Graph */
7110     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7111     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7112 
7113     /* attach info on disconnected subdomains if present */
7114     if (pcbddc->n_local_subs) {
7115       PetscInt *local_subs;
7116 
7117       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
7118       for (i=0;i<pcbddc->n_local_subs;i++) {
7119         const PetscInt *idxs;
7120         PetscInt       nl,j;
7121 
7122         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7123         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7124         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7125         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7126       }
7127       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
7128       pcbddc->mat_graph->local_subs = local_subs;
7129     }
7130   }
7131 
7132   if (!pcbddc->graphanalyzed) {
7133     /* Graph's connected components analysis */
7134     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7135     pcbddc->graphanalyzed = PETSC_TRUE;
7136     pcbddc->corner_selected = pcbddc->corner_selection;
7137   }
7138   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7139   PetscFunctionReturn(0);
7140 }
7141 
7142 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7143 {
7144   PetscInt       i,j;
7145   PetscScalar    *alphas;
7146   PetscReal      norm;
7147   PetscErrorCode ierr;
7148 
7149   PetscFunctionBegin;
7150   if (!n) PetscFunctionReturn(0);
7151   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7152   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7153   if (norm < PETSC_SMALL) {
7154     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7155   }
7156   for (i=1;i<n;i++) {
7157     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7158     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7159     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7160     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7161     if (norm < PETSC_SMALL) {
7162       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7163     }
7164   }
7165   ierr = PetscFree(alphas);CHKERRQ(ierr);
7166   PetscFunctionReturn(0);
7167 }
7168 
7169 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7170 {
7171   Mat            A;
7172   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7173   PetscMPIInt    size,rank,color;
7174   PetscInt       *xadj,*adjncy;
7175   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7176   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7177   PetscInt       void_procs,*procs_candidates = NULL;
7178   PetscInt       xadj_count,*count;
7179   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7180   PetscSubcomm   psubcomm;
7181   MPI_Comm       subcomm;
7182   PetscErrorCode ierr;
7183 
7184   PetscFunctionBegin;
7185   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7186   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7187   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);
7188   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7189   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7190   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7191 
7192   if (have_void) *have_void = PETSC_FALSE;
7193   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7194   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7195   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7196   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7197   im_active = !!n;
7198   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7199   void_procs = size - active_procs;
7200   /* get ranks of of non-active processes in mat communicator */
7201   if (void_procs) {
7202     PetscInt ncand;
7203 
7204     if (have_void) *have_void = PETSC_TRUE;
7205     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7206     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7207     for (i=0,ncand=0;i<size;i++) {
7208       if (!procs_candidates[i]) {
7209         procs_candidates[ncand++] = i;
7210       }
7211     }
7212     /* force n_subdomains to be not greater that the number of non-active processes */
7213     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7214   }
7215 
7216   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7217      number of subdomains requested 1 -> send to master or first candidate in voids  */
7218   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7219   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7220     PetscInt issize,isidx,dest;
7221     if (*n_subdomains == 1) dest = 0;
7222     else dest = rank;
7223     if (im_active) {
7224       issize = 1;
7225       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7226         isidx = procs_candidates[dest];
7227       } else {
7228         isidx = dest;
7229       }
7230     } else {
7231       issize = 0;
7232       isidx = -1;
7233     }
7234     if (*n_subdomains != 1) *n_subdomains = active_procs;
7235     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7236     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7237     PetscFunctionReturn(0);
7238   }
7239   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7240   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7241   threshold = PetscMax(threshold,2);
7242 
7243   /* Get info on mapping */
7244   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7245 
7246   /* build local CSR graph of subdomains' connectivity */
7247   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7248   xadj[0] = 0;
7249   xadj[1] = PetscMax(n_neighs-1,0);
7250   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7251   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7252   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7253   for (i=1;i<n_neighs;i++)
7254     for (j=0;j<n_shared[i];j++)
7255       count[shared[i][j]] += 1;
7256 
7257   xadj_count = 0;
7258   for (i=1;i<n_neighs;i++) {
7259     for (j=0;j<n_shared[i];j++) {
7260       if (count[shared[i][j]] < threshold) {
7261         adjncy[xadj_count] = neighs[i];
7262         adjncy_wgt[xadj_count] = n_shared[i];
7263         xadj_count++;
7264         break;
7265       }
7266     }
7267   }
7268   xadj[1] = xadj_count;
7269   ierr = PetscFree(count);CHKERRQ(ierr);
7270   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7271   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7272 
7273   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7274 
7275   /* Restrict work on active processes only */
7276   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7277   if (void_procs) {
7278     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7279     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7280     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7281     subcomm = PetscSubcommChild(psubcomm);
7282   } else {
7283     psubcomm = NULL;
7284     subcomm = PetscObjectComm((PetscObject)mat);
7285   }
7286 
7287   v_wgt = NULL;
7288   if (!color) {
7289     ierr = PetscFree(xadj);CHKERRQ(ierr);
7290     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7291     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7292   } else {
7293     Mat             subdomain_adj;
7294     IS              new_ranks,new_ranks_contig;
7295     MatPartitioning partitioner;
7296     PetscInt        rstart=0,rend=0;
7297     PetscInt        *is_indices,*oldranks;
7298     PetscMPIInt     size;
7299     PetscBool       aggregate;
7300 
7301     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7302     if (void_procs) {
7303       PetscInt prank = rank;
7304       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7305       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7306       for (i=0;i<xadj[1];i++) {
7307         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7308       }
7309       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7310     } else {
7311       oldranks = NULL;
7312     }
7313     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7314     if (aggregate) { /* TODO: all this part could be made more efficient */
7315       PetscInt    lrows,row,ncols,*cols;
7316       PetscMPIInt nrank;
7317       PetscScalar *vals;
7318 
7319       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7320       lrows = 0;
7321       if (nrank<redprocs) {
7322         lrows = size/redprocs;
7323         if (nrank<size%redprocs) lrows++;
7324       }
7325       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7326       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7327       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7328       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7329       row = nrank;
7330       ncols = xadj[1]-xadj[0];
7331       cols = adjncy;
7332       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7333       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7334       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7335       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7336       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7337       ierr = PetscFree(xadj);CHKERRQ(ierr);
7338       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7339       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7340       ierr = PetscFree(vals);CHKERRQ(ierr);
7341       if (use_vwgt) {
7342         Vec               v;
7343         const PetscScalar *array;
7344         PetscInt          nl;
7345 
7346         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7347         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7348         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7349         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7350         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7351         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7352         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7353         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7354         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7355         ierr = VecDestroy(&v);CHKERRQ(ierr);
7356       }
7357     } else {
7358       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7359       if (use_vwgt) {
7360         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7361         v_wgt[0] = n;
7362       }
7363     }
7364     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7365 
7366     /* Partition */
7367     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7368 #if defined(PETSC_HAVE_PTSCOTCH)
7369     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7370 #elif defined(PETSC_HAVE_PARMETIS)
7371     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7372 #else
7373     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7374 #endif
7375     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7376     if (v_wgt) {
7377       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7378     }
7379     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7380     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7381     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7382     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7383     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7384 
7385     /* renumber new_ranks to avoid "holes" in new set of processors */
7386     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7387     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7388     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7389     if (!aggregate) {
7390       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7391 #if defined(PETSC_USE_DEBUG)
7392         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7393 #endif
7394         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7395       } else if (oldranks) {
7396         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7397       } else {
7398         ranks_send_to_idx[0] = is_indices[0];
7399       }
7400     } else {
7401       PetscInt    idx = 0;
7402       PetscMPIInt tag;
7403       MPI_Request *reqs;
7404 
7405       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7406       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7407       for (i=rstart;i<rend;i++) {
7408         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7409       }
7410       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7411       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7412       ierr = PetscFree(reqs);CHKERRQ(ierr);
7413       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7414 #if defined(PETSC_USE_DEBUG)
7415         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7416 #endif
7417         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7418       } else if (oldranks) {
7419         ranks_send_to_idx[0] = oldranks[idx];
7420       } else {
7421         ranks_send_to_idx[0] = idx;
7422       }
7423     }
7424     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7425     /* clean up */
7426     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7427     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7428     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7429     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7430   }
7431   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7432   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7433 
7434   /* assemble parallel IS for sends */
7435   i = 1;
7436   if (!color) i=0;
7437   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7438   PetscFunctionReturn(0);
7439 }
7440 
7441 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7442 
7443 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[])
7444 {
7445   Mat                    local_mat;
7446   IS                     is_sends_internal;
7447   PetscInt               rows,cols,new_local_rows;
7448   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7449   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7450   ISLocalToGlobalMapping l2gmap;
7451   PetscInt*              l2gmap_indices;
7452   const PetscInt*        is_indices;
7453   MatType                new_local_type;
7454   /* buffers */
7455   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7456   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7457   PetscInt               *recv_buffer_idxs_local;
7458   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7459   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7460   /* MPI */
7461   MPI_Comm               comm,comm_n;
7462   PetscSubcomm           subcomm;
7463   PetscMPIInt            n_sends,n_recvs,size;
7464   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7465   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7466   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7467   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7468   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7469   PetscErrorCode         ierr;
7470 
7471   PetscFunctionBegin;
7472   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7473   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7474   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);
7475   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7476   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7477   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7478   PetscValidLogicalCollectiveBool(mat,reuse,6);
7479   PetscValidLogicalCollectiveInt(mat,nis,8);
7480   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7481   if (nvecs) {
7482     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7483     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7484   }
7485   /* further checks */
7486   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7487   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7488   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7489   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7490   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7491   if (reuse && *mat_n) {
7492     PetscInt mrows,mcols,mnrows,mncols;
7493     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7494     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7495     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7496     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7497     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7498     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7499     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7500   }
7501   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7502   PetscValidLogicalCollectiveInt(mat,bs,0);
7503 
7504   /* prepare IS for sending if not provided */
7505   if (!is_sends) {
7506     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7507     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7508   } else {
7509     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7510     is_sends_internal = is_sends;
7511   }
7512 
7513   /* get comm */
7514   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7515 
7516   /* compute number of sends */
7517   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7518   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7519 
7520   /* compute number of receives */
7521   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7522   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7523   ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
7524   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7525   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7526   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7527   ierr = PetscFree(iflags);CHKERRQ(ierr);
7528 
7529   /* restrict comm if requested */
7530   subcomm = 0;
7531   destroy_mat = PETSC_FALSE;
7532   if (restrict_comm) {
7533     PetscMPIInt color,subcommsize;
7534 
7535     color = 0;
7536     if (restrict_full) {
7537       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7538     } else {
7539       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7540     }
7541     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7542     subcommsize = size - subcommsize;
7543     /* check if reuse has been requested */
7544     if (reuse) {
7545       if (*mat_n) {
7546         PetscMPIInt subcommsize2;
7547         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7548         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7549         comm_n = PetscObjectComm((PetscObject)*mat_n);
7550       } else {
7551         comm_n = PETSC_COMM_SELF;
7552       }
7553     } else { /* MAT_INITIAL_MATRIX */
7554       PetscMPIInt rank;
7555 
7556       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7557       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7558       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7559       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7560       comm_n = PetscSubcommChild(subcomm);
7561     }
7562     /* flag to destroy *mat_n if not significative */
7563     if (color) destroy_mat = PETSC_TRUE;
7564   } else {
7565     comm_n = comm;
7566   }
7567 
7568   /* prepare send/receive buffers */
7569   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7570   ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7571   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7572   ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr);
7573   if (nis) {
7574     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7575   }
7576 
7577   /* Get data from local matrices */
7578   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7579     /* TODO: See below some guidelines on how to prepare the local buffers */
7580     /*
7581        send_buffer_vals should contain the raw values of the local matrix
7582        send_buffer_idxs should contain:
7583        - MatType_PRIVATE type
7584        - PetscInt        size_of_l2gmap
7585        - PetscInt        global_row_indices[size_of_l2gmap]
7586        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7587     */
7588   else {
7589     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7590     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7591     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7592     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7593     send_buffer_idxs[1] = i;
7594     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7595     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7596     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7597     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7598     for (i=0;i<n_sends;i++) {
7599       ilengths_vals[is_indices[i]] = len*len;
7600       ilengths_idxs[is_indices[i]] = len+2;
7601     }
7602   }
7603   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7604   /* additional is (if any) */
7605   if (nis) {
7606     PetscMPIInt psum;
7607     PetscInt j;
7608     for (j=0,psum=0;j<nis;j++) {
7609       PetscInt plen;
7610       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7611       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7612       psum += len+1; /* indices + lenght */
7613     }
7614     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7615     for (j=0,psum=0;j<nis;j++) {
7616       PetscInt plen;
7617       const PetscInt *is_array_idxs;
7618       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7619       send_buffer_idxs_is[psum] = plen;
7620       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7621       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7622       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7623       psum += plen+1; /* indices + lenght */
7624     }
7625     for (i=0;i<n_sends;i++) {
7626       ilengths_idxs_is[is_indices[i]] = psum;
7627     }
7628     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7629   }
7630   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7631 
7632   buf_size_idxs = 0;
7633   buf_size_vals = 0;
7634   buf_size_idxs_is = 0;
7635   buf_size_vecs = 0;
7636   for (i=0;i<n_recvs;i++) {
7637     buf_size_idxs += (PetscInt)olengths_idxs[i];
7638     buf_size_vals += (PetscInt)olengths_vals[i];
7639     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7640     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7641   }
7642   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7643   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7644   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7645   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7646 
7647   /* get new tags for clean communications */
7648   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7649   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7650   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7651   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7652 
7653   /* allocate for requests */
7654   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7655   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7656   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7657   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7658   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7659   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7660   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7661   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7662 
7663   /* communications */
7664   ptr_idxs = recv_buffer_idxs;
7665   ptr_vals = recv_buffer_vals;
7666   ptr_idxs_is = recv_buffer_idxs_is;
7667   ptr_vecs = recv_buffer_vecs;
7668   for (i=0;i<n_recvs;i++) {
7669     source_dest = onodes[i];
7670     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7671     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7672     ptr_idxs += olengths_idxs[i];
7673     ptr_vals += olengths_vals[i];
7674     if (nis) {
7675       source_dest = onodes_is[i];
7676       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);
7677       ptr_idxs_is += olengths_idxs_is[i];
7678     }
7679     if (nvecs) {
7680       source_dest = onodes[i];
7681       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7682       ptr_vecs += olengths_idxs[i]-2;
7683     }
7684   }
7685   for (i=0;i<n_sends;i++) {
7686     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7687     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7688     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7689     if (nis) {
7690       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);
7691     }
7692     if (nvecs) {
7693       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7694       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7695     }
7696   }
7697   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7698   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7699 
7700   /* assemble new l2g map */
7701   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7702   ptr_idxs = recv_buffer_idxs;
7703   new_local_rows = 0;
7704   for (i=0;i<n_recvs;i++) {
7705     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7706     ptr_idxs += olengths_idxs[i];
7707   }
7708   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7709   ptr_idxs = recv_buffer_idxs;
7710   new_local_rows = 0;
7711   for (i=0;i<n_recvs;i++) {
7712     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7713     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7714     ptr_idxs += olengths_idxs[i];
7715   }
7716   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7717   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7718   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7719 
7720   /* infer new local matrix type from received local matrices type */
7721   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7722   /* 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) */
7723   if (n_recvs) {
7724     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7725     ptr_idxs = recv_buffer_idxs;
7726     for (i=0;i<n_recvs;i++) {
7727       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7728         new_local_type_private = MATAIJ_PRIVATE;
7729         break;
7730       }
7731       ptr_idxs += olengths_idxs[i];
7732     }
7733     switch (new_local_type_private) {
7734       case MATDENSE_PRIVATE:
7735         new_local_type = MATSEQAIJ;
7736         bs = 1;
7737         break;
7738       case MATAIJ_PRIVATE:
7739         new_local_type = MATSEQAIJ;
7740         bs = 1;
7741         break;
7742       case MATBAIJ_PRIVATE:
7743         new_local_type = MATSEQBAIJ;
7744         break;
7745       case MATSBAIJ_PRIVATE:
7746         new_local_type = MATSEQSBAIJ;
7747         break;
7748       default:
7749         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7750         break;
7751     }
7752   } else { /* by default, new_local_type is seqaij */
7753     new_local_type = MATSEQAIJ;
7754     bs = 1;
7755   }
7756 
7757   /* create MATIS object if needed */
7758   if (!reuse) {
7759     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7760     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7761   } else {
7762     /* it also destroys the local matrices */
7763     if (*mat_n) {
7764       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7765     } else { /* this is a fake object */
7766       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7767     }
7768   }
7769   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7770   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7771 
7772   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7773 
7774   /* Global to local map of received indices */
7775   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7776   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7777   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7778 
7779   /* restore attributes -> type of incoming data and its size */
7780   buf_size_idxs = 0;
7781   for (i=0;i<n_recvs;i++) {
7782     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7783     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7784     buf_size_idxs += (PetscInt)olengths_idxs[i];
7785   }
7786   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7787 
7788   /* set preallocation */
7789   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7790   if (!newisdense) {
7791     PetscInt *new_local_nnz=0;
7792 
7793     ptr_idxs = recv_buffer_idxs_local;
7794     if (n_recvs) {
7795       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7796     }
7797     for (i=0;i<n_recvs;i++) {
7798       PetscInt j;
7799       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7800         for (j=0;j<*(ptr_idxs+1);j++) {
7801           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7802         }
7803       } else {
7804         /* TODO */
7805       }
7806       ptr_idxs += olengths_idxs[i];
7807     }
7808     if (new_local_nnz) {
7809       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7810       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7811       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7812       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7813       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7814       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7815     } else {
7816       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7817     }
7818     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7819   } else {
7820     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7821   }
7822 
7823   /* set values */
7824   ptr_vals = recv_buffer_vals;
7825   ptr_idxs = recv_buffer_idxs_local;
7826   for (i=0;i<n_recvs;i++) {
7827     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7828       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7829       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7830       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7831       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7832       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7833     } else {
7834       /* TODO */
7835     }
7836     ptr_idxs += olengths_idxs[i];
7837     ptr_vals += olengths_vals[i];
7838   }
7839   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7840   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7841   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7842   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7843   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7844   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7845 
7846 #if 0
7847   if (!restrict_comm) { /* check */
7848     Vec       lvec,rvec;
7849     PetscReal infty_error;
7850 
7851     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7852     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7853     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7854     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7855     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7856     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7857     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7858     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7859     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7860   }
7861 #endif
7862 
7863   /* assemble new additional is (if any) */
7864   if (nis) {
7865     PetscInt **temp_idxs,*count_is,j,psum;
7866 
7867     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7868     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7869     ptr_idxs = recv_buffer_idxs_is;
7870     psum = 0;
7871     for (i=0;i<n_recvs;i++) {
7872       for (j=0;j<nis;j++) {
7873         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7874         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7875         psum += plen;
7876         ptr_idxs += plen+1; /* shift pointer to received data */
7877       }
7878     }
7879     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7880     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7881     for (i=1;i<nis;i++) {
7882       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7883     }
7884     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7885     ptr_idxs = recv_buffer_idxs_is;
7886     for (i=0;i<n_recvs;i++) {
7887       for (j=0;j<nis;j++) {
7888         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7889         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7890         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7891         ptr_idxs += plen+1; /* shift pointer to received data */
7892       }
7893     }
7894     for (i=0;i<nis;i++) {
7895       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7896       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7897       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7898     }
7899     ierr = PetscFree(count_is);CHKERRQ(ierr);
7900     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7901     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7902   }
7903   /* free workspace */
7904   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7905   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7906   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7907   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7908   if (isdense) {
7909     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7910     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7911     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7912   } else {
7913     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7914   }
7915   if (nis) {
7916     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7917     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7918   }
7919 
7920   if (nvecs) {
7921     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7922     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7923     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7924     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7925     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7926     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7927     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7928     /* set values */
7929     ptr_vals = recv_buffer_vecs;
7930     ptr_idxs = recv_buffer_idxs_local;
7931     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7932     for (i=0;i<n_recvs;i++) {
7933       PetscInt j;
7934       for (j=0;j<*(ptr_idxs+1);j++) {
7935         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7936       }
7937       ptr_idxs += olengths_idxs[i];
7938       ptr_vals += olengths_idxs[i]-2;
7939     }
7940     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7941     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7942     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7943   }
7944 
7945   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7946   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7947   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7948   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7949   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7950   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7951   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7952   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7953   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7954   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7955   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7956   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7957   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7958   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7959   ierr = PetscFree(onodes);CHKERRQ(ierr);
7960   if (nis) {
7961     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7962     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7963     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7964   }
7965   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7966   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7967     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7968     for (i=0;i<nis;i++) {
7969       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7970     }
7971     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7972       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7973     }
7974     *mat_n = NULL;
7975   }
7976   PetscFunctionReturn(0);
7977 }
7978 
7979 /* temporary hack into ksp private data structure */
7980 #include <petsc/private/kspimpl.h>
7981 
7982 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7983 {
7984   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7985   PC_IS                  *pcis = (PC_IS*)pc->data;
7986   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7987   Mat                    coarsedivudotp = NULL;
7988   Mat                    coarseG,t_coarse_mat_is;
7989   MatNullSpace           CoarseNullSpace = NULL;
7990   ISLocalToGlobalMapping coarse_islg;
7991   IS                     coarse_is,*isarray,corners;
7992   PetscInt               i,im_active=-1,active_procs=-1;
7993   PetscInt               nis,nisdofs,nisneu,nisvert;
7994   PetscInt               coarse_eqs_per_proc;
7995   PC                     pc_temp;
7996   PCType                 coarse_pc_type;
7997   KSPType                coarse_ksp_type;
7998   PetscBool              multilevel_requested,multilevel_allowed;
7999   PetscBool              coarse_reuse;
8000   PetscInt               ncoarse,nedcfield;
8001   PetscBool              compute_vecs = PETSC_FALSE;
8002   PetscScalar            *array;
8003   MatReuse               coarse_mat_reuse;
8004   PetscBool              restr, full_restr, have_void;
8005   PetscMPIInt            size;
8006   PetscErrorCode         ierr;
8007 
8008   PetscFunctionBegin;
8009   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8010   /* Assign global numbering to coarse dofs */
8011   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 */
8012     PetscInt ocoarse_size;
8013     compute_vecs = PETSC_TRUE;
8014 
8015     pcbddc->new_primal_space = PETSC_TRUE;
8016     ocoarse_size = pcbddc->coarse_size;
8017     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8018     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8019     /* see if we can avoid some work */
8020     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8021       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8022       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8023         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8024         coarse_reuse = PETSC_FALSE;
8025       } else { /* we can safely reuse already computed coarse matrix */
8026         coarse_reuse = PETSC_TRUE;
8027       }
8028     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8029       coarse_reuse = PETSC_FALSE;
8030     }
8031     /* reset any subassembling information */
8032     if (!coarse_reuse || pcbddc->recompute_topography) {
8033       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8034     }
8035   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8036     coarse_reuse = PETSC_TRUE;
8037   }
8038   if (coarse_reuse && pcbddc->coarse_ksp) {
8039     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8040     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8041     coarse_mat_reuse = MAT_REUSE_MATRIX;
8042   } else {
8043     coarse_mat = NULL;
8044     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8045   }
8046 
8047   /* creates temporary l2gmap and IS for coarse indexes */
8048   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8049   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8050 
8051   /* creates temporary MATIS object for coarse matrix */
8052   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8053   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);
8054   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8055   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8056   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8057   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8058 
8059   /* count "active" (i.e. with positive local size) and "void" processes */
8060   im_active = !!(pcis->n);
8061   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8062 
8063   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8064   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8065   /* full_restr : just use the receivers from the subassembling pattern */
8066   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8067   coarse_mat_is        = NULL;
8068   multilevel_allowed   = PETSC_FALSE;
8069   multilevel_requested = PETSC_FALSE;
8070   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8071   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8072   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8073   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8074   if (multilevel_requested) {
8075     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8076     restr      = PETSC_FALSE;
8077     full_restr = PETSC_FALSE;
8078   } else {
8079     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8080     restr      = PETSC_TRUE;
8081     full_restr = PETSC_TRUE;
8082   }
8083   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8084   ncoarse = PetscMax(1,ncoarse);
8085   if (!pcbddc->coarse_subassembling) {
8086     if (pcbddc->coarsening_ratio > 1) {
8087       if (multilevel_requested) {
8088         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8089       } else {
8090         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8091       }
8092     } else {
8093       PetscMPIInt rank;
8094       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8095       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8096       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8097     }
8098   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8099     PetscInt    psum;
8100     if (pcbddc->coarse_ksp) psum = 1;
8101     else psum = 0;
8102     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8103     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8104   }
8105   /* determine if we can go multilevel */
8106   if (multilevel_requested) {
8107     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8108     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8109   }
8110   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8111 
8112   /* dump subassembling pattern */
8113   if (pcbddc->dbg_flag && multilevel_allowed) {
8114     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8115   }
8116   /* compute dofs splitting and neumann boundaries for coarse dofs */
8117   nedcfield = -1;
8118   corners = NULL;
8119   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneded computations */
8120     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8121     const PetscInt         *idxs;
8122     ISLocalToGlobalMapping tmap;
8123 
8124     /* create map between primal indices (in local representative ordering) and local primal numbering */
8125     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8126     /* allocate space for temporary storage */
8127     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8128     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8129     /* allocate for IS array */
8130     nisdofs = pcbddc->n_ISForDofsLocal;
8131     if (pcbddc->nedclocal) {
8132       if (pcbddc->nedfield > -1) {
8133         nedcfield = pcbddc->nedfield;
8134       } else {
8135         nedcfield = 0;
8136         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8137         nisdofs = 1;
8138       }
8139     }
8140     nisneu = !!pcbddc->NeumannBoundariesLocal;
8141     nisvert = 0; /* nisvert is not used */
8142     nis = nisdofs + nisneu + nisvert;
8143     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8144     /* dofs splitting */
8145     for (i=0;i<nisdofs;i++) {
8146       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8147       if (nedcfield != i) {
8148         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8149         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8150         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8151         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8152       } else {
8153         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8154         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8155         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8156         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8157         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8158       }
8159       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8160       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8161       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8162     }
8163     /* neumann boundaries */
8164     if (pcbddc->NeumannBoundariesLocal) {
8165       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8166       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8167       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8168       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8169       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8170       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8171       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8172       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8173     }
8174     /* coordinates */
8175     if (pcbddc->corner_selected) {
8176       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8177       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8178       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8179       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8180       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8181       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8182       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8183       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8184       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8185     }
8186     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8187     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8188     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8189   } else {
8190     nis = 0;
8191     nisdofs = 0;
8192     nisneu = 0;
8193     nisvert = 0;
8194     isarray = NULL;
8195   }
8196   /* destroy no longer needed map */
8197   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8198 
8199   /* subassemble */
8200   if (multilevel_allowed) {
8201     Vec       vp[1];
8202     PetscInt  nvecs = 0;
8203     PetscBool reuse,reuser;
8204 
8205     if (coarse_mat) reuse = PETSC_TRUE;
8206     else reuse = PETSC_FALSE;
8207     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8208     vp[0] = NULL;
8209     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8210       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8211       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8212       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8213       nvecs = 1;
8214 
8215       if (pcbddc->divudotp) {
8216         Mat      B,loc_divudotp;
8217         Vec      v,p;
8218         IS       dummy;
8219         PetscInt np;
8220 
8221         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8222         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8223         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8224         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8225         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8226         ierr = VecSet(p,1.);CHKERRQ(ierr);
8227         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8228         ierr = VecDestroy(&p);CHKERRQ(ierr);
8229         ierr = MatDestroy(&B);CHKERRQ(ierr);
8230         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8231         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8232         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8233         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8234         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8235         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8236         ierr = VecDestroy(&v);CHKERRQ(ierr);
8237       }
8238     }
8239     if (reuser) {
8240       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8241     } else {
8242       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8243     }
8244     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8245       PetscScalar *arraym,*arrayv;
8246       PetscInt    nl;
8247       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8248       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8249       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8250       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8251       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8252       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8253       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8254       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8255     } else {
8256       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8257     }
8258   } else {
8259     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8260   }
8261   if (coarse_mat_is || coarse_mat) {
8262     if (!multilevel_allowed) {
8263       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8264     } else {
8265       Mat A;
8266 
8267       /* if this matrix is present, it means we are not reusing the coarse matrix */
8268       if (coarse_mat_is) {
8269         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8270         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8271         coarse_mat = coarse_mat_is;
8272       }
8273       /* be sure we don't have MatSeqDENSE as local mat */
8274       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8275       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8276     }
8277   }
8278   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8279   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8280 
8281   /* create local to global scatters for coarse problem */
8282   if (compute_vecs) {
8283     PetscInt lrows;
8284     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8285     if (coarse_mat) {
8286       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8287     } else {
8288       lrows = 0;
8289     }
8290     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8291     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8292     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8293     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8294     ierr = VecScatterCreateWithData(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8295   }
8296   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8297 
8298   /* set defaults for coarse KSP and PC */
8299   if (multilevel_allowed) {
8300     coarse_ksp_type = KSPRICHARDSON;
8301     coarse_pc_type  = PCBDDC;
8302   } else {
8303     coarse_ksp_type = KSPPREONLY;
8304     coarse_pc_type  = PCREDUNDANT;
8305   }
8306 
8307   /* print some info if requested */
8308   if (pcbddc->dbg_flag) {
8309     if (!multilevel_allowed) {
8310       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8311       if (multilevel_requested) {
8312         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);
8313       } else if (pcbddc->max_levels) {
8314         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8315       }
8316       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8317     }
8318   }
8319 
8320   /* communicate coarse discrete gradient */
8321   coarseG = NULL;
8322   if (pcbddc->nedcG && multilevel_allowed) {
8323     MPI_Comm ccomm;
8324     if (coarse_mat) {
8325       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8326     } else {
8327       ccomm = MPI_COMM_NULL;
8328     }
8329     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8330   }
8331 
8332   /* create the coarse KSP object only once with defaults */
8333   if (coarse_mat) {
8334     PetscBool   isredundant,isnn,isbddc;
8335     PetscViewer dbg_viewer = NULL;
8336 
8337     if (pcbddc->dbg_flag) {
8338       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8339       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8340     }
8341     if (!pcbddc->coarse_ksp) {
8342       char   prefix[256],str_level[16];
8343       size_t len;
8344 
8345       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8346       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8347       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8348       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8349       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8350       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8351       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8352       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8353       /* TODO is this logic correct? should check for coarse_mat type */
8354       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8355       /* prefix */
8356       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8357       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8358       if (!pcbddc->current_level) {
8359         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8360         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8361       } else {
8362         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8363         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8364         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8365         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8366         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8367         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8368         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8369       }
8370       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8371       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8372       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8373       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8374       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8375       /* allow user customization */
8376       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8377       /* get some info after set from options */
8378       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8379       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8380       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8381       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8382       if (multilevel_allowed && !isbddc && !isnn) {
8383         isbddc = PETSC_TRUE;
8384         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8385         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8386         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8387         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8388         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8389           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8390           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8391           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8392           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8393           pc_temp->setfromoptionscalled++;
8394         }
8395       }
8396     }
8397     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8398     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8399     if (nisdofs) {
8400       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8401       for (i=0;i<nisdofs;i++) {
8402         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8403       }
8404     }
8405     if (nisneu) {
8406       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8407       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8408     }
8409     if (nisvert) {
8410       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8411       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8412     }
8413     if (coarseG) {
8414       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8415     }
8416 
8417     /* get some info after set from options */
8418     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8419 
8420     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8421     if (isbddc && !multilevel_allowed) {
8422       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8423       isbddc = PETSC_FALSE;
8424     }
8425     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8426     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8427     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8428       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8429       isbddc = PETSC_TRUE;
8430     }
8431     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8432     if (isredundant) {
8433       KSP inner_ksp;
8434       PC  inner_pc;
8435 
8436       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8437       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8438     }
8439 
8440     /* parameters which miss an API */
8441     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8442     if (isbddc) {
8443       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8444 
8445       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8446       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8447       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8448       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8449       if (pcbddc_coarse->benign_saddle_point) {
8450         Mat                    coarsedivudotp_is;
8451         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8452         IS                     row,col;
8453         const PetscInt         *gidxs;
8454         PetscInt               n,st,M,N;
8455 
8456         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8457         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8458         st   = st-n;
8459         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8460         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8461         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8462         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8463         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8464         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8465         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8466         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8467         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8468         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8469         ierr = ISDestroy(&row);CHKERRQ(ierr);
8470         ierr = ISDestroy(&col);CHKERRQ(ierr);
8471         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8472         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8473         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8474         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8475         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8476         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8477         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8478         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8479         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8480         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8481         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8482         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8483       }
8484     }
8485 
8486     /* propagate symmetry info of coarse matrix */
8487     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8488     if (pc->pmat->symmetric_set) {
8489       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8490     }
8491     if (pc->pmat->hermitian_set) {
8492       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8493     }
8494     if (pc->pmat->spd_set) {
8495       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8496     }
8497     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8498       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8499     }
8500     /* set operators */
8501     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8502     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8503     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8504     if (pcbddc->dbg_flag) {
8505       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8506     }
8507   }
8508   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8509   ierr = PetscFree(isarray);CHKERRQ(ierr);
8510 #if 0
8511   {
8512     PetscViewer viewer;
8513     char filename[256];
8514     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8515     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8516     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8517     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8518     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8519     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8520   }
8521 #endif
8522 
8523   if (corners) {
8524     Vec            gv;
8525     IS             is;
8526     const PetscInt *idxs;
8527     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8528     PetscScalar    *coords;
8529 
8530     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8531     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8532     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8533     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8534     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8535     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8536     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8537     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8538     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8539 
8540     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8541     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8542     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8543     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8544     for (i=0;i<n;i++) {
8545       for (d=0;d<cdim;d++) {
8546         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8547       }
8548     }
8549     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8550     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8551 
8552     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8553     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8554     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8555     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8556     ierr = PetscFree(coords);CHKERRQ(ierr);
8557     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8558     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8559     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8560     if (pcbddc->coarse_ksp) {
8561       PC        coarse_pc;
8562       PetscBool isbddc;
8563 
8564       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8565       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8566       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8567         PetscReal *realcoords;
8568 
8569         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8570 #if defined(PETSC_USE_COMPLEX)
8571         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8572         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8573 #else
8574         realcoords = coords;
8575 #endif
8576         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8577 #if defined(PETSC_USE_COMPLEX)
8578         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8579 #endif
8580       }
8581     }
8582     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8583     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8584   }
8585   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8586 
8587   if (pcbddc->coarse_ksp) {
8588     Vec crhs,csol;
8589 
8590     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8591     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8592     if (!csol) {
8593       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8594     }
8595     if (!crhs) {
8596       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8597     }
8598   }
8599   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8600 
8601   /* compute null space for coarse solver if the benign trick has been requested */
8602   if (pcbddc->benign_null) {
8603 
8604     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8605     for (i=0;i<pcbddc->benign_n;i++) {
8606       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8607     }
8608     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8609     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8610     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8611     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8612     if (coarse_mat) {
8613       Vec         nullv;
8614       PetscScalar *array,*array2;
8615       PetscInt    nl;
8616 
8617       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8618       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8619       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8620       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8621       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8622       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8623       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8624       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8625       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8626       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8627     }
8628   }
8629   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8630 
8631   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8632   if (pcbddc->coarse_ksp) {
8633     PetscBool ispreonly;
8634 
8635     if (CoarseNullSpace) {
8636       PetscBool isnull;
8637       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8638       if (isnull) {
8639         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8640       }
8641       /* TODO: add local nullspaces (if any) */
8642     }
8643     /* setup coarse ksp */
8644     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8645     /* Check coarse problem if in debug mode or if solving with an iterative method */
8646     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8647     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8648       KSP       check_ksp;
8649       KSPType   check_ksp_type;
8650       PC        check_pc;
8651       Vec       check_vec,coarse_vec;
8652       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8653       PetscInt  its;
8654       PetscBool compute_eigs;
8655       PetscReal *eigs_r,*eigs_c;
8656       PetscInt  neigs;
8657       const char *prefix;
8658 
8659       /* Create ksp object suitable for estimation of extreme eigenvalues */
8660       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8661       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8662       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8663       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8664       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8665       /* prevent from setup unneeded object */
8666       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8667       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8668       if (ispreonly) {
8669         check_ksp_type = KSPPREONLY;
8670         compute_eigs = PETSC_FALSE;
8671       } else {
8672         check_ksp_type = KSPGMRES;
8673         compute_eigs = PETSC_TRUE;
8674       }
8675       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8676       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8677       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8678       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8679       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8680       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8681       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8682       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8683       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8684       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8685       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8686       /* create random vec */
8687       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8688       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8689       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8690       /* solve coarse problem */
8691       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8692       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8693       /* set eigenvalue estimation if preonly has not been requested */
8694       if (compute_eigs) {
8695         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8696         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8697         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8698         if (neigs) {
8699           lambda_max = eigs_r[neigs-1];
8700           lambda_min = eigs_r[0];
8701           if (pcbddc->use_coarse_estimates) {
8702             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8703               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8704               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8705             }
8706           }
8707         }
8708       }
8709 
8710       /* check coarse problem residual error */
8711       if (pcbddc->dbg_flag) {
8712         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8713         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8714         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8715         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8716         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8717         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8718         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8719         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8720         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8721         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8722         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8723         if (CoarseNullSpace) {
8724           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8725         }
8726         if (compute_eigs) {
8727           PetscReal          lambda_max_s,lambda_min_s;
8728           KSPConvergedReason reason;
8729           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8730           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8731           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8732           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8733           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);
8734           for (i=0;i<neigs;i++) {
8735             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8736           }
8737         }
8738         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8739         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8740       }
8741       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8742       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8743       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8744       if (compute_eigs) {
8745         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8746         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8747       }
8748     }
8749   }
8750   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8751   /* print additional info */
8752   if (pcbddc->dbg_flag) {
8753     /* waits until all processes reaches this point */
8754     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8755     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8756     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8757   }
8758 
8759   /* free memory */
8760   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8761   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8762   PetscFunctionReturn(0);
8763 }
8764 
8765 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8766 {
8767   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8768   PC_IS*         pcis = (PC_IS*)pc->data;
8769   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8770   IS             subset,subset_mult,subset_n;
8771   PetscInt       local_size,coarse_size=0;
8772   PetscInt       *local_primal_indices=NULL;
8773   const PetscInt *t_local_primal_indices;
8774   PetscErrorCode ierr;
8775 
8776   PetscFunctionBegin;
8777   /* Compute global number of coarse dofs */
8778   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8779   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8780   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8781   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8782   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8783   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8784   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8785   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8786   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8787   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);
8788   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8789   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8790   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8791   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8792   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8793 
8794   /* check numbering */
8795   if (pcbddc->dbg_flag) {
8796     PetscScalar coarsesum,*array,*array2;
8797     PetscInt    i;
8798     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8799 
8800     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8801     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8802     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8803     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8804     /* counter */
8805     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8806     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8807     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8808     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8809     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8810     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8811     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8812     for (i=0;i<pcbddc->local_primal_size;i++) {
8813       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8814     }
8815     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8816     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8817     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8818     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8819     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8820     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8821     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8822     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8823     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8824     for (i=0;i<pcis->n;i++) {
8825       if (array[i] != 0.0 && array[i] != array2[i]) {
8826         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8827         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8828         set_error = PETSC_TRUE;
8829         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8830         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);
8831       }
8832     }
8833     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8834     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8835     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8836     for (i=0;i<pcis->n;i++) {
8837       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8838     }
8839     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8840     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8841     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8842     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8843     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8844     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8845     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8846       PetscInt *gidxs;
8847 
8848       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8849       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8850       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8851       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8852       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8853       for (i=0;i<pcbddc->local_primal_size;i++) {
8854         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);
8855       }
8856       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8857       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8858     }
8859     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8860     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8861     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8862   }
8863 
8864   /* get back data */
8865   *coarse_size_n = coarse_size;
8866   *local_primal_indices_n = local_primal_indices;
8867   PetscFunctionReturn(0);
8868 }
8869 
8870 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8871 {
8872   IS             localis_t;
8873   PetscInt       i,lsize,*idxs,n;
8874   PetscScalar    *vals;
8875   PetscErrorCode ierr;
8876 
8877   PetscFunctionBegin;
8878   /* get indices in local ordering exploiting local to global map */
8879   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8880   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8881   for (i=0;i<lsize;i++) vals[i] = 1.0;
8882   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8883   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8884   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8885   if (idxs) { /* multilevel guard */
8886     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8887     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8888   }
8889   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8890   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8891   ierr = PetscFree(vals);CHKERRQ(ierr);
8892   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8893   /* now compute set in local ordering */
8894   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8895   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8896   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8897   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8898   for (i=0,lsize=0;i<n;i++) {
8899     if (PetscRealPart(vals[i]) > 0.5) {
8900       lsize++;
8901     }
8902   }
8903   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8904   for (i=0,lsize=0;i<n;i++) {
8905     if (PetscRealPart(vals[i]) > 0.5) {
8906       idxs[lsize++] = i;
8907     }
8908   }
8909   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8910   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8911   *localis = localis_t;
8912   PetscFunctionReturn(0);
8913 }
8914 
8915 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8916 {
8917   PC_IS               *pcis=(PC_IS*)pc->data;
8918   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8919   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8920   Mat                 S_j;
8921   PetscInt            *used_xadj,*used_adjncy;
8922   PetscBool           free_used_adj;
8923   PetscErrorCode      ierr;
8924 
8925   PetscFunctionBegin;
8926   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8927   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8928   free_used_adj = PETSC_FALSE;
8929   if (pcbddc->sub_schurs_layers == -1) {
8930     used_xadj = NULL;
8931     used_adjncy = NULL;
8932   } else {
8933     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8934       used_xadj = pcbddc->mat_graph->xadj;
8935       used_adjncy = pcbddc->mat_graph->adjncy;
8936     } else if (pcbddc->computed_rowadj) {
8937       used_xadj = pcbddc->mat_graph->xadj;
8938       used_adjncy = pcbddc->mat_graph->adjncy;
8939     } else {
8940       PetscBool      flg_row=PETSC_FALSE;
8941       const PetscInt *xadj,*adjncy;
8942       PetscInt       nvtxs;
8943 
8944       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8945       if (flg_row) {
8946         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8947         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8948         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8949         free_used_adj = PETSC_TRUE;
8950       } else {
8951         pcbddc->sub_schurs_layers = -1;
8952         used_xadj = NULL;
8953         used_adjncy = NULL;
8954       }
8955       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8956     }
8957   }
8958 
8959   /* setup sub_schurs data */
8960   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8961   if (!sub_schurs->schur_explicit) {
8962     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8963     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8964     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);
8965   } else {
8966     Mat       change = NULL;
8967     Vec       scaling = NULL;
8968     IS        change_primal = NULL, iP;
8969     PetscInt  benign_n;
8970     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8971     PetscBool isseqaij,need_change = PETSC_FALSE;
8972     PetscBool discrete_harmonic = PETSC_FALSE;
8973 
8974     if (!pcbddc->use_vertices && reuse_solvers) {
8975       PetscInt n_vertices;
8976 
8977       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8978       reuse_solvers = (PetscBool)!n_vertices;
8979     }
8980     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8981     if (!isseqaij) {
8982       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8983       if (matis->A == pcbddc->local_mat) {
8984         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8985         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8986       } else {
8987         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8988       }
8989     }
8990     if (!pcbddc->benign_change_explicit) {
8991       benign_n = pcbddc->benign_n;
8992     } else {
8993       benign_n = 0;
8994     }
8995     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8996        We need a global reduction to avoid possible deadlocks.
8997        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8998     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8999       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9000       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9001       need_change = (PetscBool)(!need_change);
9002     }
9003     /* If the user defines additional constraints, we import them here.
9004        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 */
9005     if (need_change) {
9006       PC_IS   *pcisf;
9007       PC_BDDC *pcbddcf;
9008       PC      pcf;
9009 
9010       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9011       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9012       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9013       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9014 
9015       /* hacks */
9016       pcisf                        = (PC_IS*)pcf->data;
9017       pcisf->is_B_local            = pcis->is_B_local;
9018       pcisf->vec1_N                = pcis->vec1_N;
9019       pcisf->BtoNmap               = pcis->BtoNmap;
9020       pcisf->n                     = pcis->n;
9021       pcisf->n_B                   = pcis->n_B;
9022       pcbddcf                      = (PC_BDDC*)pcf->data;
9023       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9024       pcbddcf->mat_graph           = pcbddc->mat_graph;
9025       pcbddcf->use_faces           = PETSC_TRUE;
9026       pcbddcf->use_change_of_basis = PETSC_TRUE;
9027       pcbddcf->use_change_on_faces = PETSC_TRUE;
9028       pcbddcf->use_qr_single       = PETSC_TRUE;
9029       pcbddcf->fake_change         = PETSC_TRUE;
9030 
9031       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9032       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9033       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9034       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9035       change = pcbddcf->ConstraintMatrix;
9036       pcbddcf->ConstraintMatrix = NULL;
9037 
9038       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9039       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9040       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9041       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9042       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9043       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9044       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9045       pcf->ops->destroy = NULL;
9046       pcf->ops->reset   = NULL;
9047       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9048     }
9049     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9050 
9051     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9052     if (iP) {
9053       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9054       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9055       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9056     }
9057     if (discrete_harmonic) {
9058       Mat A;
9059       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9060       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9061       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9062       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);
9063       ierr = MatDestroy(&A);CHKERRQ(ierr);
9064     } else {
9065       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);
9066     }
9067     ierr = MatDestroy(&change);CHKERRQ(ierr);
9068     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9069   }
9070   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9071 
9072   /* free adjacency */
9073   if (free_used_adj) {
9074     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9075   }
9076   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9077   PetscFunctionReturn(0);
9078 }
9079 
9080 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9081 {
9082   PC_IS               *pcis=(PC_IS*)pc->data;
9083   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9084   PCBDDCGraph         graph;
9085   PetscErrorCode      ierr;
9086 
9087   PetscFunctionBegin;
9088   /* attach interface graph for determining subsets */
9089   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9090     IS       verticesIS,verticescomm;
9091     PetscInt vsize,*idxs;
9092 
9093     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9094     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9095     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9096     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9097     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9098     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9099     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9100     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9101     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9102     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9103     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9104   } else {
9105     graph = pcbddc->mat_graph;
9106   }
9107   /* print some info */
9108   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9109     IS       vertices;
9110     PetscInt nv,nedges,nfaces;
9111     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9112     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9113     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9114     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9115     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9116     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9117     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9118     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9119     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9120     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9121     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9122   }
9123 
9124   /* sub_schurs init */
9125   if (!pcbddc->sub_schurs) {
9126     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9127   }
9128   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);
9129 
9130   /* free graph struct */
9131   if (pcbddc->sub_schurs_rebuild) {
9132     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9133   }
9134   PetscFunctionReturn(0);
9135 }
9136 
9137 PetscErrorCode PCBDDCCheckOperator(PC pc)
9138 {
9139   PC_IS               *pcis=(PC_IS*)pc->data;
9140   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9141   PetscErrorCode      ierr;
9142 
9143   PetscFunctionBegin;
9144   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9145     IS             zerodiag = NULL;
9146     Mat            S_j,B0_B=NULL;
9147     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9148     PetscScalar    *p0_check,*array,*array2;
9149     PetscReal      norm;
9150     PetscInt       i;
9151 
9152     /* B0 and B0_B */
9153     if (zerodiag) {
9154       IS       dummy;
9155 
9156       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9157       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9158       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9159       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9160     }
9161     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9162     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9163     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9164     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9165     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9166     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9167     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9168     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9169     /* S_j */
9170     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9171     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9172 
9173     /* mimic vector in \widetilde{W}_\Gamma */
9174     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9175     /* continuous in primal space */
9176     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9177     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9178     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9179     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9180     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9181     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9182     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9183     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9184     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9185     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9186     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9187     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9188     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9189     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9190 
9191     /* assemble rhs for coarse problem */
9192     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9193     /* local with Schur */
9194     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9195     if (zerodiag) {
9196       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9197       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9198       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9199       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9200     }
9201     /* sum on primal nodes the local contributions */
9202     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9203     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9204     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9205     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9206     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9207     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9208     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9209     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9210     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9211     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9212     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9213     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9214     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9215     /* scale primal nodes (BDDC sums contibutions) */
9216     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9217     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9218     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9219     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9220     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9221     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9222     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9223     /* global: \widetilde{B0}_B w_\Gamma */
9224     if (zerodiag) {
9225       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9226       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9227       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9228       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9229     }
9230     /* BDDC */
9231     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9232     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9233 
9234     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9235     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9236     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9237     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9238     for (i=0;i<pcbddc->benign_n;i++) {
9239       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);
9240     }
9241     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9242     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9243     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9244     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9245     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9246     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9247   }
9248   PetscFunctionReturn(0);
9249 }
9250 
9251 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9252 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9253 {
9254   Mat            At;
9255   IS             rows;
9256   PetscInt       rst,ren;
9257   PetscErrorCode ierr;
9258   PetscLayout    rmap;
9259 
9260   PetscFunctionBegin;
9261   rst = ren = 0;
9262   if (ccomm != MPI_COMM_NULL) {
9263     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9264     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9265     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9266     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9267     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9268   }
9269   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9270   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9271   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9272 
9273   if (ccomm != MPI_COMM_NULL) {
9274     Mat_MPIAIJ *a,*b;
9275     IS         from,to;
9276     Vec        gvec;
9277     PetscInt   lsize;
9278 
9279     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9280     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9281     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9282     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9283     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9284     a    = (Mat_MPIAIJ*)At->data;
9285     b    = (Mat_MPIAIJ*)(*B)->data;
9286     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9287     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9288     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9289     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9290     b->A = a->A;
9291     b->B = a->B;
9292 
9293     b->donotstash      = a->donotstash;
9294     b->roworiented     = a->roworiented;
9295     b->rowindices      = 0;
9296     b->rowvalues       = 0;
9297     b->getrowactive    = PETSC_FALSE;
9298 
9299     (*B)->rmap         = rmap;
9300     (*B)->factortype   = A->factortype;
9301     (*B)->assembled    = PETSC_TRUE;
9302     (*B)->insertmode   = NOT_SET_VALUES;
9303     (*B)->preallocated = PETSC_TRUE;
9304 
9305     if (a->colmap) {
9306 #if defined(PETSC_USE_CTABLE)
9307       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9308 #else
9309       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9310       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9311       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9312 #endif
9313     } else b->colmap = 0;
9314     if (a->garray) {
9315       PetscInt len;
9316       len  = a->B->cmap->n;
9317       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9318       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9319       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9320     } else b->garray = 0;
9321 
9322     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9323     b->lvec = a->lvec;
9324     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9325 
9326     /* cannot use VecScatterCopy */
9327     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9328     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9329     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9330     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9331     ierr = VecScatterCreateWithData(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9332     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9333     ierr = ISDestroy(&from);CHKERRQ(ierr);
9334     ierr = ISDestroy(&to);CHKERRQ(ierr);
9335     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9336   }
9337   ierr = MatDestroy(&At);CHKERRQ(ierr);
9338   PetscFunctionReturn(0);
9339 }
9340