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