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