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