xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 3d96e9964ff330fd2a9eee374bcd4376da7efe60) !
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 <petscdmplex.h>
5 #include <petscblaslapack.h>
6 #include <petsc/private/sfimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 
9 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
10 
11 /* if range is true,  it returns B s.t. span{B} = range(A)
12    if range is false, it returns B s.t. range(B) _|_ range(A) */
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
89 {
90   PetscErrorCode ierr;
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
97   if (!esize) PetscFunctionReturn(0);
98   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
99   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
105   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
106   ierr = MatDestroy(&GE);CHKERRQ(ierr);
107 
108   /* constants */
109   ptr += rsize*csize;
110   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
111   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
112   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
113   ierr = MatDestroy(&GE);CHKERRQ(ierr);
114   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
115   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
116 
117   if (corners) {
118     Mat            GEc;
119     PetscScalar    *vals,v;
120 
121     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
122     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
123     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
124     /* v    = PetscAbsScalar(vals[0]) */;
125     v    = 1.;
126     cvals[0] = vals[0]/v;
127     cvals[1] = vals[1]/v;
128     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
129     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
130 #if defined(PRINT_GDET)
131     {
132       PetscViewer viewer;
133       char filename[256];
134       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
135       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
136       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
138       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
140       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
142       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
143       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
144     }
145 #endif
146     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
147     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 PetscErrorCode PCBDDCNedelecSupport(PC pc)
154 {
155   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
156   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
157   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
158   Vec                    tvec;
159   PetscSF                sfv;
160   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
161   MPI_Comm               comm;
162   IS                     lned,primals,allprimals,nedfieldlocal;
163   IS                     *eedges,*extrows,*extcols,*alleedges;
164   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
165   PetscScalar            *vals,*work;
166   PetscReal              *rwork;
167   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
168   PetscInt               ne,nv,Lv,order,n,field;
169   PetscInt               n_neigh,*neigh,*n_shared,**shared;
170   PetscInt               i,j,extmem,cum,maxsize,nee;
171   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
172   PetscInt               *sfvleaves,*sfvroots;
173   PetscInt               *corners,*cedges;
174   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
175 #if defined(PETSC_USE_DEBUG)
176   PetscInt               *emarks;
177 #endif
178   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
179   PetscErrorCode         ierr;
180 
181   PetscFunctionBegin;
182   /* If the discrete gradient is defined for a subset of dofs and global is true,
183      it assumes G is given in global ordering for all the dofs.
184      Otherwise, the ordering is global for the Nedelec field */
185   order      = pcbddc->nedorder;
186   conforming = pcbddc->conforming;
187   field      = pcbddc->nedfield;
188   global     = pcbddc->nedglobal;
189   setprimal  = PETSC_FALSE;
190   print      = PETSC_FALSE;
191   singular   = PETSC_FALSE;
192 
193   /* Command line customization */
194   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
198   /* print debug info TODO: to be removed */
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsEnd();CHKERRQ(ierr);
201 
202   /* Return if there are no edges in the decomposition and the problem is not singular */
203   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
204   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
205   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
206   if (!singular) {
207     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
208     lrc[0] = PETSC_FALSE;
209     for (i=0;i<n;i++) {
210       if (PetscRealPart(vals[i]) > 2.) {
211         lrc[0] = PETSC_TRUE;
212         break;
213       }
214     }
215     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
216     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
217     if (!lrc[1]) PetscFunctionReturn(0);
218   }
219 
220   /* Get Nedelec field */
221   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
222   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);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
235     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   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);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
322   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
456   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
458   for (i=1,cum=0;i<n_neigh;i++) {
459     cum += n_shared[i];
460     for (j=0;j<n_shared[i];j++) {
461       ecount[shared[i][j]]++;
462     }
463   }
464   if (ne) {
465     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
466   }
467   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
468   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
469   for (i=1;i<n_neigh;i++) {
470     for (j=0;j<n_shared[i];j++) {
471       PetscInt k = shared[i][j];
472       eneighs[k][ecount[k]] = neigh[i];
473       ecount[k]++;
474     }
475   }
476   for (i=0;i<ne;i++) {
477     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
478   }
479   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
480   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
482   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
483   for (i=1,cum=0;i<n_neigh;i++) {
484     cum += n_shared[i];
485     for (j=0;j<n_shared[i];j++) {
486       vcount[shared[i][j]]++;
487     }
488   }
489   if (nv) {
490     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
491   }
492   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
493   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
494   for (i=1;i<n_neigh;i++) {
495     for (j=0;j<n_shared[i];j++) {
496       PetscInt k = shared[i][j];
497       vneighs[k][vcount[k]] = neigh[i];
498       vcount[k]++;
499     }
500   }
501   for (i=0;i<nv;i++) {
502     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
503   }
504   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
505 
506   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
507      for proper detection of coarse edges' endpoints */
508   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
509   for (i=0;i<ne;i++) {
510     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
511       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
512     }
513   }
514   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
515   if (!conforming) {
516     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
517     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
518   }
519   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
521   cum  = 0;
522   for (i=0;i<ne;i++) {
523     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
524     if (!PetscBTLookup(btee,i)) {
525       marks[cum++] = i;
526       continue;
527     }
528     /* set badly connected edge dofs as primal */
529     if (!conforming) {
530       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
531         marks[cum++] = i;
532         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
533         for (j=ii[i];j<ii[i+1];j++) {
534           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
535         }
536       } else {
537         /* every edge dofs should be connected trough a certain number of nodal dofs
538            to other edge dofs belonging to coarse edges
539            - at most 2 endpoints
540            - order-1 interior nodal dofs
541            - no undefined nodal dofs (nconn < order)
542         */
543         PetscInt ends = 0,ints = 0, undef = 0;
544         for (j=ii[i];j<ii[i+1];j++) {
545           PetscInt v = jj[j],k;
546           PetscInt nconn = iit[v+1]-iit[v];
547           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
548           if (nconn > order) ends++;
549           else if (nconn == order) ints++;
550           else undef++;
551         }
552         if (undef || ends > 2 || ints != order -1) {
553           marks[cum++] = i;
554           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
555           for (j=ii[i];j<ii[i+1];j++) {
556             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
557           }
558         }
559       }
560     }
561     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
562     if (!order && ii[i+1] != ii[i]) {
563       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
564       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
565     }
566   }
567   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
568   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
569   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
570   if (!conforming) {
571     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
572     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
573   }
574   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
575 
576   /* identify splitpoints and corner candidates */
577   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
578   if (print) {
579     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
580     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
582     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
583   }
584   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
585   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
586   for (i=0;i<nv;i++) {
587     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
588     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
589     if (!order) { /* variable order */
590       PetscReal vorder = 0.;
591 
592       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
593       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
594       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
595       ord  = 1;
596     }
597 #if defined(PETSC_USE_DEBUG)
598     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);
599 #endif
600     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
601       if (PetscBTLookup(btbd,jj[j])) {
602         bdir = PETSC_TRUE;
603         break;
604       }
605       if (vc != ecount[jj[j]]) {
606         sneighs = PETSC_FALSE;
607       } else {
608         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
609         for (k=0;k<vc;k++) {
610           if (vn[k] != en[k]) {
611             sneighs = PETSC_FALSE;
612             break;
613           }
614         }
615       }
616     }
617     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
618       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
619       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
620     } else if (test == ord) {
621       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
622         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
623         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624       } else {
625         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
626         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
627       }
628     }
629   }
630   ierr = PetscFree(ecount);CHKERRQ(ierr);
631   ierr = PetscFree(vcount);CHKERRQ(ierr);
632   if (ne) {
633     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
634   }
635   if (nv) {
636     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
637   }
638   ierr = PetscFree(eneighs);CHKERRQ(ierr);
639   ierr = PetscFree(vneighs);CHKERRQ(ierr);
640   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
641 
642   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
643   if (order != 1) {
644     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
645     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
646     for (i=0;i<nv;i++) {
647       if (PetscBTLookup(btvcand,i)) {
648         PetscBool found = PETSC_FALSE;
649         for (j=ii[i];j<ii[i+1] && !found;j++) {
650           PetscInt k,e = jj[j];
651           if (PetscBTLookup(bte,e)) continue;
652           for (k=iit[e];k<iit[e+1];k++) {
653             PetscInt v = jjt[k];
654             if (v != i && PetscBTLookup(btvcand,v)) {
655               found = PETSC_TRUE;
656               break;
657             }
658           }
659         }
660         if (!found) {
661           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
662           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
663         } else {
664           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
665         }
666       }
667     }
668     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
669   }
670   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
671   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
672   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
673 
674   /* Get the local G^T explicitly */
675   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
676   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
677   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
678 
679   /* Mark interior nodal dofs */
680   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
681   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
682   for (i=1;i<n_neigh;i++) {
683     for (j=0;j<n_shared[i];j++) {
684       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
685     }
686   }
687   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
688 
689   /* communicate corners and splitpoints */
690   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
691   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
692   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
693   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
694 
695   if (print) {
696     IS tbz;
697 
698     cum = 0;
699     for (i=0;i<nv;i++)
700       if (sfvleaves[i])
701         vmarks[cum++] = i;
702 
703     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
704     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
705     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
706     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
707   }
708 
709   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
710   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
711   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
712   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
713 
714   /* Zero rows of lGt corresponding to identified corners
715      and interior nodal dofs */
716   cum = 0;
717   for (i=0;i<nv;i++) {
718     if (sfvleaves[i]) {
719       vmarks[cum++] = i;
720       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
721     }
722     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
723   }
724   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
725   if (print) {
726     IS tbz;
727 
728     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
729     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
730     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
731     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
732   }
733   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
734   ierr = PetscFree(vmarks);CHKERRQ(ierr);
735   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
736   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
737 
738   /* Recompute G */
739   ierr = MatDestroy(&lG);CHKERRQ(ierr);
740   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
741   if (print) {
742     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
743     ierr = MatView(lG,NULL);CHKERRQ(ierr);
744     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
745     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
746   }
747 
748   /* Get primal dofs (if any) */
749   cum = 0;
750   for (i=0;i<ne;i++) {
751     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
752   }
753   if (fl2g) {
754     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
755   }
756   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
757   if (print) {
758     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
759     ierr = ISView(primals,NULL);CHKERRQ(ierr);
760   }
761   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
762   /* TODO: what if the user passed in some of them ?  */
763   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
764   ierr = ISDestroy(&primals);CHKERRQ(ierr);
765 
766   /* Compute edge connectivity */
767   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
768   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
769   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
770   if (fl2g) {
771     PetscBT   btf;
772     PetscInt  *iia,*jja,*iiu,*jju;
773     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
774 
775     /* create CSR for all local dofs */
776     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
777     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
778       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
779       iiu = pcbddc->mat_graph->xadj;
780       jju = pcbddc->mat_graph->adjncy;
781     } else if (pcbddc->use_local_adj) {
782       rest = PETSC_TRUE;
783       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
784     } else {
785       free   = PETSC_TRUE;
786       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
787       iiu[0] = 0;
788       for (i=0;i<n;i++) {
789         iiu[i+1] = i+1;
790         jju[i]   = -1;
791       }
792     }
793 
794     /* import sizes of CSR */
795     iia[0] = 0;
796     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
797 
798     /* overwrite entries corresponding to the Nedelec field */
799     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
800     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
801     for (i=0;i<ne;i++) {
802       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
803       iia[idxs[i]+1] = ii[i+1]-ii[i];
804     }
805 
806     /* iia in CSR */
807     for (i=0;i<n;i++) iia[i+1] += iia[i];
808 
809     /* jja in CSR */
810     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
811     for (i=0;i<n;i++)
812       if (!PetscBTLookup(btf,i))
813         for (j=0;j<iiu[i+1]-iiu[i];j++)
814           jja[iia[i]+j] = jju[iiu[i]+j];
815 
816     /* map edge dofs connectivity */
817     if (jj) {
818       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
819       for (i=0;i<ne;i++) {
820         PetscInt e = idxs[i];
821         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
822       }
823     }
824     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
825     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
826     if (rest) {
827       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
828     }
829     if (free) {
830       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
831     }
832     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
833   } else {
834     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
835   }
836 
837   /* Analyze interface for edge dofs */
838   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
839   pcbddc->mat_graph->twodim = PETSC_FALSE;
840 
841   /* Get coarse edges in the edge space */
842   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
843   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
844 
845   if (fl2g) {
846     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
847     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
848     for (i=0;i<nee;i++) {
849       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
850     }
851   } else {
852     eedges  = alleedges;
853     primals = allprimals;
854   }
855 
856   /* Mark fine edge dofs with their coarse edge id */
857   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
858   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
859   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
860   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
861   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
862   if (print) {
863     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
864     ierr = ISView(primals,NULL);CHKERRQ(ierr);
865   }
866 
867   maxsize = 0;
868   for (i=0;i<nee;i++) {
869     PetscInt size,mark = i+1;
870 
871     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
872     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     for (j=0;j<size;j++) marks[idxs[j]] = mark;
874     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     maxsize = PetscMax(maxsize,size);
876   }
877 
878   /* Find coarse edge endpoints */
879   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
880   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
881   for (i=0;i<nee;i++) {
882     PetscInt mark = i+1,size;
883 
884     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
885     if (!size && nedfieldlocal) continue;
886     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
887     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
888     if (print) {
889       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
890       ISView(eedges[i],NULL);
891     }
892     for (j=0;j<size;j++) {
893       PetscInt k, ee = idxs[j];
894       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
895       for (k=ii[ee];k<ii[ee+1];k++) {
896         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
897         if (PetscBTLookup(btv,jj[k])) {
898           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
899         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
900           PetscInt  k2;
901           PetscBool corner = PETSC_FALSE;
902           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
903             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]));
904             /* it's a corner if either is connected with an edge dof belonging to a different cc or
905                if the edge dof lie on the natural part of the boundary */
906             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
907               corner = PETSC_TRUE;
908               break;
909             }
910           }
911           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
912             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
913             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
914           } else {
915             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
916           }
917         }
918       }
919     }
920     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
921   }
922   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
923   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
924   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
925 
926   /* Reset marked primal dofs */
927   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
928   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
929   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
930   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
931 
932   /* Now use the initial lG */
933   ierr = MatDestroy(&lG);CHKERRQ(ierr);
934   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
935   lG   = lGinit;
936   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
937 
938   /* Compute extended cols indices */
939   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
940   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
941   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
942   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
943   i   *= maxsize;
944   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
945   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
946   eerr = PETSC_FALSE;
947   for (i=0;i<nee;i++) {
948     PetscInt size,found = 0;
949 
950     cum  = 0;
951     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
952     if (!size && nedfieldlocal) continue;
953     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
954     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
955     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
956     for (j=0;j<size;j++) {
957       PetscInt k,ee = idxs[j];
958       for (k=ii[ee];k<ii[ee+1];k++) {
959         PetscInt vv = jj[k];
960         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
961         else if (!PetscBTLookupSet(btvc,vv)) found++;
962       }
963     }
964     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
965     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
966     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
967     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
968     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
969     /* it may happen that endpoints are not defined at this point
970        if it is the case, mark this edge for a second pass */
971     if (cum != size -1 || found != 2) {
972       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
973       if (print) {
974         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
975         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
976         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
977         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
978       }
979       eerr = PETSC_TRUE;
980     }
981   }
982   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
983   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
984   if (done) {
985     PetscInt *newprimals;
986 
987     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
988     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
989     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
991     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
993     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
994     for (i=0;i<nee;i++) {
995       PetscBool has_candidates = PETSC_FALSE;
996       if (PetscBTLookup(bter,i)) {
997         PetscInt size,mark = i+1;
998 
999         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1000         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1002         for (j=0;j<size;j++) {
1003           PetscInt k,ee = idxs[j];
1004           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1005           for (k=ii[ee];k<ii[ee+1];k++) {
1006             /* set all candidates located on the edge as corners */
1007             if (PetscBTLookup(btvcand,jj[k])) {
1008               PetscInt k2,vv = jj[k];
1009               has_candidates = PETSC_TRUE;
1010               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1011               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1012               /* set all edge dofs connected to candidate as primals */
1013               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1014                 if (marks[jjt[k2]] == mark) {
1015                   PetscInt k3,ee2 = jjt[k2];
1016                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1017                   newprimals[cum++] = ee2;
1018                   /* finally set the new corners */
1019                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1020                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1021                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1022                   }
1023                 }
1024               }
1025             } else {
1026               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1027             }
1028           }
1029         }
1030         if (!has_candidates) { /* circular edge */
1031           PetscInt k, ee = idxs[0],*tmarks;
1032 
1033           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1034           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1035           for (k=ii[ee];k<ii[ee+1];k++) {
1036             PetscInt k2;
1037             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1038             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1039             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1040           }
1041           for (j=0;j<size;j++) {
1042             if (tmarks[idxs[j]] > 1) {
1043               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1044               newprimals[cum++] = idxs[j];
1045             }
1046           }
1047           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1048         }
1049         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1050       }
1051       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1052     }
1053     ierr = PetscFree(extcols);CHKERRQ(ierr);
1054     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1055     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1056     if (fl2g) {
1057       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1058       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1059       for (i=0;i<nee;i++) {
1060         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1061       }
1062       ierr = PetscFree(eedges);CHKERRQ(ierr);
1063     }
1064     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1065     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1066     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1067     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1068     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1069     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1070     pcbddc->mat_graph->twodim = PETSC_FALSE;
1071     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1072     if (fl2g) {
1073       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1074       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1075       for (i=0;i<nee;i++) {
1076         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1077       }
1078     } else {
1079       eedges  = alleedges;
1080       primals = allprimals;
1081     }
1082     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1083 
1084     /* Mark again */
1085     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1086     for (i=0;i<nee;i++) {
1087       PetscInt size,mark = i+1;
1088 
1089       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1090       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1092       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093     }
1094     if (print) {
1095       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1096       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1097     }
1098 
1099     /* Recompute extended cols */
1100     eerr = PETSC_FALSE;
1101     for (i=0;i<nee;i++) {
1102       PetscInt size;
1103 
1104       cum  = 0;
1105       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1106       if (!size && nedfieldlocal) continue;
1107       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1108       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1109       for (j=0;j<size;j++) {
1110         PetscInt k,ee = idxs[j];
1111         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1112       }
1113       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1114       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1115       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1116       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1117       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1118       if (cum != size -1) {
1119         if (print) {
1120           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1122           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1124         }
1125         eerr = PETSC_TRUE;
1126       }
1127     }
1128   }
1129   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1130   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1131   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1132   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1133   /* an error should not occur at this point */
1134   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1135 
1136   /* Check the number of endpoints */
1137   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1140   for (i=0;i<nee;i++) {
1141     PetscInt size, found = 0, gc[2];
1142 
1143     /* init with defaults */
1144     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1145     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1146     if (!size && nedfieldlocal) continue;
1147     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1148     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1149     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1150     for (j=0;j<size;j++) {
1151       PetscInt k,ee = idxs[j];
1152       for (k=ii[ee];k<ii[ee+1];k++) {
1153         PetscInt vv = jj[k];
1154         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1155           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1156           corners[i*2+found++] = vv;
1157         }
1158       }
1159     }
1160     if (found != 2) {
1161       PetscInt e;
1162       if (fl2g) {
1163         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1164       } else {
1165         e = idxs[0];
1166       }
1167       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1168     }
1169 
1170     /* get primal dof index on this coarse edge */
1171     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1172     if (gc[0] > gc[1]) {
1173       PetscInt swap  = corners[2*i];
1174       corners[2*i]   = corners[2*i+1];
1175       corners[2*i+1] = swap;
1176     }
1177     cedges[i] = idxs[size-1];
1178     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1179     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1180   }
1181   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1182   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1183 
1184 #if defined(PETSC_USE_DEBUG)
1185   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1186      not interfere with neighbouring coarse edges */
1187   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1188   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1189   for (i=0;i<nv;i++) {
1190     PetscInt emax = 0,eemax = 0;
1191 
1192     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1193     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1194     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1195     for (j=1;j<nee+1;j++) {
1196       if (emax < emarks[j]) {
1197         emax = emarks[j];
1198         eemax = j;
1199       }
1200     }
1201     /* not relevant for edges */
1202     if (!eemax) continue;
1203 
1204     for (j=ii[i];j<ii[i+1];j++) {
1205       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1206         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\n",marks[jj[j]]-1,eemax,i,jj[j]);
1207       }
1208     }
1209   }
1210   ierr = PetscFree(emarks);CHKERRQ(ierr);
1211   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1212 #endif
1213 
1214   /* Compute extended rows indices for edge blocks of the change of basis */
1215   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1217   extmem *= maxsize;
1218   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1219   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1220   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1221   for (i=0;i<nv;i++) {
1222     PetscInt mark = 0,size,start;
1223 
1224     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1225     for (j=ii[i];j<ii[i+1];j++)
1226       if (marks[jj[j]] && !mark)
1227         mark = marks[jj[j]];
1228 
1229     /* not relevant */
1230     if (!mark) continue;
1231 
1232     /* import extended row */
1233     mark--;
1234     start = mark*extmem+extrowcum[mark];
1235     size = ii[i+1]-ii[i];
1236     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1237     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1238     extrowcum[mark] += size;
1239   }
1240   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1241   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1242   ierr = PetscFree(marks);CHKERRQ(ierr);
1243 
1244   /* Compress extrows */
1245   cum  = 0;
1246   for (i=0;i<nee;i++) {
1247     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1248     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1249     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1250     cum  = PetscMax(cum,size);
1251   }
1252   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1253   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1254   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1255 
1256   /* Workspace for lapack inner calls and VecSetValues */
1257   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1258 
1259   /* Create change of basis matrix (preallocation can be improved) */
1260   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1261   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1262                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1263   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1264   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1265   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1266   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1267   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1268   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1269   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1270 
1271   /* Defaults to identity */
1272   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1273   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1274   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1275   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1276 
1277   /* Create discrete gradient for the coarser level if needed */
1278   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1279   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1280   if (pcbddc->current_level < pcbddc->max_levels) {
1281     ISLocalToGlobalMapping cel2g,cvl2g;
1282     IS                     wis,gwis;
1283     PetscInt               cnv,cne;
1284 
1285     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1286     if (fl2g) {
1287       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1288     } else {
1289       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1290       pcbddc->nedclocal = wis;
1291     }
1292     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1293     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1294     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1295     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1296     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1298 
1299     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1300     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1302     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1303     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1304     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1306 
1307     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1308     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1309     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1310     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1311     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1312     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1313     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1314     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1317 
1318 #if defined(PRINT_GDET)
1319   inc = 0;
1320   lev = pcbddc->current_level;
1321 #endif
1322 
1323   /* Insert values in the change of basis matrix */
1324   for (i=0;i<nee;i++) {
1325     Mat         Gins = NULL, GKins = NULL;
1326     IS          cornersis = NULL;
1327     PetscScalar cvals[2];
1328 
1329     if (pcbddc->nedcG) {
1330       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1331     }
1332     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1333     if (Gins && GKins) {
1334       PetscScalar    *data;
1335       const PetscInt *rows,*cols;
1336       PetscInt       nrh,nch,nrc,ncc;
1337 
1338       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1339       /* H1 */
1340       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1341       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1342       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1344       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1346       /* complement */
1347       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1348       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1349       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);
1350       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);
1351       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1352       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1353       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1354 
1355       /* coarse discrete gradient */
1356       if (pcbddc->nedcG) {
1357         PetscInt cols[2];
1358 
1359         cols[0] = 2*i;
1360         cols[1] = 2*i+1;
1361         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1362       }
1363       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1364     }
1365     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1366     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1367     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1368     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1369     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1370   }
1371   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1372 
1373   /* Start assembling */
1374   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   if (pcbddc->nedcG) {
1376     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   }
1378 
1379   /* Free */
1380   if (fl2g) {
1381     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1382     for (i=0;i<nee;i++) {
1383       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1384     }
1385     ierr = PetscFree(eedges);CHKERRQ(ierr);
1386   }
1387 
1388   /* hack mat_graph with primal dofs on the coarse edges */
1389   {
1390     PCBDDCGraph graph   = pcbddc->mat_graph;
1391     PetscInt    *oqueue = graph->queue;
1392     PetscInt    *ocptr  = graph->cptr;
1393     PetscInt    ncc,*idxs;
1394 
1395     /* find first primal edge */
1396     if (pcbddc->nedclocal) {
1397       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1398     } else {
1399       if (fl2g) {
1400         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1401       }
1402       idxs = cedges;
1403     }
1404     cum = 0;
1405     while (cum < nee && cedges[cum] < 0) cum++;
1406 
1407     /* adapt connected components */
1408     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1409     graph->cptr[0] = 0;
1410     for (i=0,ncc=0;i<graph->ncc;i++) {
1411       PetscInt lc = ocptr[i+1]-ocptr[i];
1412       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1413         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1414         graph->queue[graph->cptr[ncc]] = cedges[cum];
1415         ncc++;
1416         lc--;
1417         cum++;
1418         while (cum < nee && cedges[cum] < 0) cum++;
1419       }
1420       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1421       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1422       ncc++;
1423     }
1424     graph->ncc = ncc;
1425     if (pcbddc->nedclocal) {
1426       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1427     }
1428     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1429   }
1430   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1431   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1432   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1433   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1434 
1435   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1436   ierr = PetscFree(extrow);CHKERRQ(ierr);
1437   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1438   ierr = PetscFree(corners);CHKERRQ(ierr);
1439   ierr = PetscFree(cedges);CHKERRQ(ierr);
1440   ierr = PetscFree(extrows);CHKERRQ(ierr);
1441   ierr = PetscFree(extcols);CHKERRQ(ierr);
1442   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1443 
1444   /* Complete assembling */
1445   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446   if (pcbddc->nedcG) {
1447     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448 #if 0
1449     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1450     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1451 #endif
1452   }
1453 
1454   /* set change of basis */
1455   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1456   ierr = MatDestroy(&T);CHKERRQ(ierr);
1457 
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 /* the near-null space of BDDC carries information on quadrature weights,
1462    and these can be collinear -> so cheat with MatNullSpaceCreate
1463    and create a suitable set of basis vectors first */
1464 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1465 {
1466   PetscErrorCode ierr;
1467   PetscInt       i;
1468 
1469   PetscFunctionBegin;
1470   for (i=0;i<nvecs;i++) {
1471     PetscInt first,last;
1472 
1473     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1474     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1475     if (i>=first && i < last) {
1476       PetscScalar *data;
1477       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1478       if (!has_const) {
1479         data[i-first] = 1.;
1480       } else {
1481         data[2*i-first] = 1./PetscSqrtReal(2.);
1482         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1483       }
1484       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1485     }
1486     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1487   }
1488   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<nvecs;i++) { /* reset vectors */
1490     PetscInt first,last;
1491     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1492     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1493     if (i>=first && i < last) {
1494       PetscScalar *data;
1495       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496       if (!has_const) {
1497         data[i-first] = 0.;
1498       } else {
1499         data[2*i-first] = 0.;
1500         data[2*i-first+1] = 0.;
1501       }
1502       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1503     }
1504     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1505     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1506   }
1507   PetscFunctionReturn(0);
1508 }
1509 
1510 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1511 {
1512   Mat                    loc_divudotp;
1513   Vec                    p,v,vins,quad_vec,*quad_vecs;
1514   ISLocalToGlobalMapping map;
1515   IS                     *faces,*edges;
1516   PetscScalar            *vals;
1517   const PetscScalar      *array;
1518   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1519   PetscMPIInt            rank;
1520   PetscErrorCode         ierr;
1521 
1522   PetscFunctionBegin;
1523   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1524   if (graph->twodim) {
1525     lmaxneighs = 2;
1526   } else {
1527     lmaxneighs = 1;
1528     for (i=0;i<ne;i++) {
1529       const PetscInt *idxs;
1530       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1531       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1532       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1533     }
1534     lmaxneighs++; /* graph count does not include self */
1535   }
1536   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1537   maxsize = 0;
1538   for (i=0;i<ne;i++) {
1539     PetscInt nn;
1540     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1541     maxsize = PetscMax(maxsize,nn);
1542   }
1543   for (i=0;i<nf;i++) {
1544     PetscInt nn;
1545     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1546     maxsize = PetscMax(maxsize,nn);
1547   }
1548   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1549   /* create vectors to hold quadrature weights */
1550   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1551   if (!transpose) {
1552     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1553   } else {
1554     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1555   }
1556   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1558   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1559   for (i=0;i<maxneighs;i++) {
1560     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1561     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1562   }
1563 
1564   /* compute local quad vec */
1565   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1566   if (!transpose) {
1567     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1568   } else {
1569     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1570   }
1571   ierr = VecSet(p,1.);CHKERRQ(ierr);
1572   if (!transpose) {
1573     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1574   } else {
1575     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1576   }
1577   if (vl2l) {
1578     Mat        lA;
1579     VecScatter sc;
1580 
1581     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1582     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1583     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1584     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1585     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1586     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx  = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1641 {
1642   PetscErrorCode ierr;
1643   Vec            local,global;
1644   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1645   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1646 
1647   PetscFunctionBegin;
1648   /* need to convert from global to local topology information and remove references to information in global ordering */
1649   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1650   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1651   if (pcbddc->user_provided_isfordofs) {
1652     if (pcbddc->n_ISForDofs) {
1653       PetscInt i;
1654       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1655       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1656         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1657         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1658       }
1659       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1660       pcbddc->n_ISForDofs = 0;
1661       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1662     }
1663   } else {
1664     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1665       DM dm;
1666 
1667       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1668       if (!dm) {
1669         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1670       }
1671       if (dm) {
1672         IS      *fields;
1673         PetscInt nf,i;
1674         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1675         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1676         for (i=0;i<nf;i++) {
1677           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1678           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1679         }
1680         ierr = PetscFree(fields);CHKERRQ(ierr);
1681         pcbddc->n_ISForDofsLocal = nf;
1682       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1683         PetscContainer   c;
1684 
1685         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1686         if (c) {
1687           MatISLocalFields lf;
1688           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1689           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1690         } else { /* fallback, create the default fields if bs > 1 */
1691           PetscInt i, n = matis->A->rmap->n;
1692           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1693           if (i > 1) {
1694             pcbddc->n_ISForDofsLocal = i;
1695             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1696             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1697               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1698             }
1699           }
1700         }
1701       }
1702     } else {
1703       PetscInt i;
1704       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1705         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1706       }
1707     }
1708   }
1709 
1710   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1711     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1712   } else if (pcbddc->DirichletBoundariesLocal) {
1713     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1714   }
1715   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1716     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1717   } else if (pcbddc->NeumannBoundariesLocal) {
1718     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1719   }
1720   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1721     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1722   }
1723   ierr = VecDestroy(&global);CHKERRQ(ierr);
1724   ierr = VecDestroy(&local);CHKERRQ(ierr);
1725 
1726   PetscFunctionReturn(0);
1727 }
1728 
1729 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1730 {
1731   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1732   PetscErrorCode  ierr;
1733   IS              nis;
1734   const PetscInt  *idxs;
1735   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1736   PetscBool       *ld;
1737 
1738   PetscFunctionBegin;
1739   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1740   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1741   if (mop == MPI_LAND) {
1742     /* init rootdata with true */
1743     ld   = (PetscBool*) matis->sf_rootdata;
1744     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1745   } else {
1746     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1747   }
1748   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1749   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1750   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1751   ld   = (PetscBool*) matis->sf_leafdata;
1752   for (i=0;i<nd;i++)
1753     if (-1 < idxs[i] && idxs[i] < n)
1754       ld[idxs[i]] = PETSC_TRUE;
1755   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1756   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1757   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1758   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1759   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1760   if (mop == MPI_LAND) {
1761     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1762   } else {
1763     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1764   }
1765   for (i=0,nnd=0;i<n;i++)
1766     if (ld[i])
1767       nidxs[nnd++] = i;
1768   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1769   ierr = ISDestroy(is);CHKERRQ(ierr);
1770   *is  = nis;
1771   PetscFunctionReturn(0);
1772 }
1773 
1774 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1775 {
1776   PC_IS             *pcis = (PC_IS*)(pc->data);
1777   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1778   PetscErrorCode    ierr;
1779 
1780   PetscFunctionBegin;
1781   if (!pcbddc->benign_have_null) {
1782     PetscFunctionReturn(0);
1783   }
1784   if (pcbddc->ChangeOfBasisMatrix) {
1785     Vec swap;
1786 
1787     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1788     swap = pcbddc->work_change;
1789     pcbddc->work_change = r;
1790     r = swap;
1791   }
1792   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1793   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1794   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1795   ierr = VecSet(z,0.);CHKERRQ(ierr);
1796   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1797   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1798   if (pcbddc->ChangeOfBasisMatrix) {
1799     pcbddc->work_change = r;
1800     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1801     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1802   }
1803   PetscFunctionReturn(0);
1804 }
1805 
1806 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1807 {
1808   PCBDDCBenignMatMult_ctx ctx;
1809   PetscErrorCode          ierr;
1810   PetscBool               apply_right,apply_left,reset_x;
1811 
1812   PetscFunctionBegin;
1813   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1814   if (transpose) {
1815     apply_right = ctx->apply_left;
1816     apply_left = ctx->apply_right;
1817   } else {
1818     apply_right = ctx->apply_right;
1819     apply_left = ctx->apply_left;
1820   }
1821   reset_x = PETSC_FALSE;
1822   if (apply_right) {
1823     const PetscScalar *ax;
1824     PetscInt          nl,i;
1825 
1826     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1827     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1828     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1829     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1830     for (i=0;i<ctx->benign_n;i++) {
1831       PetscScalar    sum,val;
1832       const PetscInt *idxs;
1833       PetscInt       nz,j;
1834       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1835       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1836       sum = 0.;
1837       if (ctx->apply_p0) {
1838         val = ctx->work[idxs[nz-1]];
1839         for (j=0;j<nz-1;j++) {
1840           sum += ctx->work[idxs[j]];
1841           ctx->work[idxs[j]] += val;
1842         }
1843       } else {
1844         for (j=0;j<nz-1;j++) {
1845           sum += ctx->work[idxs[j]];
1846         }
1847       }
1848       ctx->work[idxs[nz-1]] -= sum;
1849       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1850     }
1851     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1852     reset_x = PETSC_TRUE;
1853   }
1854   if (transpose) {
1855     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1856   } else {
1857     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1858   }
1859   if (reset_x) {
1860     ierr = VecResetArray(x);CHKERRQ(ierr);
1861   }
1862   if (apply_left) {
1863     PetscScalar *ay;
1864     PetscInt    i;
1865 
1866     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1867     for (i=0;i<ctx->benign_n;i++) {
1868       PetscScalar    sum,val;
1869       const PetscInt *idxs;
1870       PetscInt       nz,j;
1871       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1872       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1873       val = -ay[idxs[nz-1]];
1874       if (ctx->apply_p0) {
1875         sum = 0.;
1876         for (j=0;j<nz-1;j++) {
1877           sum += ay[idxs[j]];
1878           ay[idxs[j]] += val;
1879         }
1880         ay[idxs[nz-1]] += sum;
1881       } else {
1882         for (j=0;j<nz-1;j++) {
1883           ay[idxs[j]] += val;
1884         }
1885         ay[idxs[nz-1]] = 0.;
1886       }
1887       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1888     }
1889     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1890   }
1891   PetscFunctionReturn(0);
1892 }
1893 
1894 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1895 {
1896   PetscErrorCode ierr;
1897 
1898   PetscFunctionBegin;
1899   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1900   PetscFunctionReturn(0);
1901 }
1902 
1903 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1904 {
1905   PetscErrorCode ierr;
1906 
1907   PetscFunctionBegin;
1908   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1909   PetscFunctionReturn(0);
1910 }
1911 
1912 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1913 {
1914   PC_IS                   *pcis = (PC_IS*)pc->data;
1915   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1916   PCBDDCBenignMatMult_ctx ctx;
1917   PetscErrorCode          ierr;
1918 
1919   PetscFunctionBegin;
1920   if (!restore) {
1921     Mat                A_IB,A_BI;
1922     PetscScalar        *work;
1923     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1924 
1925     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1926     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1927     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1928     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1929     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1930     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1931     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1932     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1933     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1934     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1935     ctx->apply_left = PETSC_TRUE;
1936     ctx->apply_right = PETSC_FALSE;
1937     ctx->apply_p0 = PETSC_FALSE;
1938     ctx->benign_n = pcbddc->benign_n;
1939     if (reuse) {
1940       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1941       ctx->free = PETSC_FALSE;
1942     } else { /* TODO: could be optimized for successive solves */
1943       ISLocalToGlobalMapping N_to_D;
1944       PetscInt               i;
1945 
1946       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1947       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1948       for (i=0;i<pcbddc->benign_n;i++) {
1949         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1950       }
1951       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1952       ctx->free = PETSC_TRUE;
1953     }
1954     ctx->A = pcis->A_IB;
1955     ctx->work = work;
1956     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1957     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1958     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1959     pcis->A_IB = A_IB;
1960 
1961     /* A_BI as A_IB^T */
1962     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1963     pcbddc->benign_original_mat = pcis->A_BI;
1964     pcis->A_BI = A_BI;
1965   } else {
1966     if (!pcbddc->benign_original_mat) {
1967       PetscFunctionReturn(0);
1968     }
1969     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1970     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1971     pcis->A_IB = ctx->A;
1972     ctx->A = NULL;
1973     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1974     pcis->A_BI = pcbddc->benign_original_mat;
1975     pcbddc->benign_original_mat = NULL;
1976     if (ctx->free) {
1977       PetscInt i;
1978       for (i=0;i<ctx->benign_n;i++) {
1979         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1980       }
1981       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1982     }
1983     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1984     ierr = PetscFree(ctx);CHKERRQ(ierr);
1985   }
1986   PetscFunctionReturn(0);
1987 }
1988 
1989 /* used just in bddc debug mode */
1990 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1991 {
1992   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1993   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1994   Mat            An;
1995   PetscErrorCode ierr;
1996 
1997   PetscFunctionBegin;
1998   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1999   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2000   if (is1) {
2001     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2002     ierr = MatDestroy(&An);CHKERRQ(ierr);
2003   } else {
2004     *B = An;
2005   }
2006   PetscFunctionReturn(0);
2007 }
2008 
2009 /* TODO: add reuse flag */
2010 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2011 {
2012   Mat            Bt;
2013   PetscScalar    *a,*bdata;
2014   const PetscInt *ii,*ij;
2015   PetscInt       m,n,i,nnz,*bii,*bij;
2016   PetscBool      flg_row;
2017   PetscErrorCode ierr;
2018 
2019   PetscFunctionBegin;
2020   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2021   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2022   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2023   nnz = n;
2024   for (i=0;i<ii[n];i++) {
2025     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2026   }
2027   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2028   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2029   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2030   nnz = 0;
2031   bii[0] = 0;
2032   for (i=0;i<n;i++) {
2033     PetscInt j;
2034     for (j=ii[i];j<ii[i+1];j++) {
2035       PetscScalar entry = a[j];
2036       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2037         bij[nnz] = ij[j];
2038         bdata[nnz] = entry;
2039         nnz++;
2040       }
2041     }
2042     bii[i+1] = nnz;
2043   }
2044   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2045   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2046   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2047   {
2048     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2049     b->free_a = PETSC_TRUE;
2050     b->free_ij = PETSC_TRUE;
2051   }
2052   *B = Bt;
2053   PetscFunctionReturn(0);
2054 }
2055 
2056 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2057 {
2058   Mat                    B = NULL;
2059   DM                     dm;
2060   IS                     is_dummy,*cc_n;
2061   ISLocalToGlobalMapping l2gmap_dummy;
2062   PCBDDCGraph            graph;
2063   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2064   PetscInt               i,n;
2065   PetscInt               *xadj,*adjncy;
2066   PetscBool              isplex = PETSC_FALSE;
2067   PetscErrorCode         ierr;
2068 
2069   PetscFunctionBegin;
2070   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2071   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2072   if (!dm) {
2073     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2074   }
2075   if (dm) {
2076     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2077   }
2078   if (isplex) { /* this code has been modified from plexpartition.c */
2079     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2080     PetscInt      *adj = NULL;
2081     IS             cellNumbering;
2082     const PetscInt *cellNum;
2083     PetscBool      useCone, useClosure;
2084     PetscSection   section;
2085     PetscSegBuffer adjBuffer;
2086     PetscSF        sfPoint;
2087     PetscErrorCode ierr;
2088 
2089     PetscFunctionBegin;
2090     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2091     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2092     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2093     /* Build adjacency graph via a section/segbuffer */
2094     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2095     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2096     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2097     /* Always use FVM adjacency to create partitioner graph */
2098     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2099     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2100     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2101     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2102     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2103     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2104     for (n = 0, p = pStart; p < pEnd; p++) {
2105       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2106       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2107       adjSize = PETSC_DETERMINE;
2108       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2109       for (a = 0; a < adjSize; ++a) {
2110         const PetscInt point = adj[a];
2111         if (pStart <= point && point < pEnd) {
2112           PetscInt *PETSC_RESTRICT pBuf;
2113           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2114           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2115           *pBuf = point;
2116         }
2117       }
2118       n++;
2119     }
2120     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2121     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2122     /* Derive CSR graph from section/segbuffer */
2123     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2124     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2125     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2126     for (idx = 0, p = pStart; p < pEnd; p++) {
2127       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2128       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2129     }
2130     xadj[n] = size;
2131     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2132     /* Clean up */
2133     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2134     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2135     ierr = PetscFree(adj);CHKERRQ(ierr);
2136     graph->xadj = xadj;
2137     graph->adjncy = adjncy;
2138   } else {
2139     Mat       A;
2140     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2141 
2142     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2143     if (!A->rmap->N || !A->cmap->N) {
2144       *ncc = 0;
2145       *cc = NULL;
2146       PetscFunctionReturn(0);
2147     }
2148     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2149     if (!isseqaij && filter) {
2150       PetscBool isseqdense;
2151 
2152       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2153       if (!isseqdense) {
2154         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2155       } else { /* TODO: rectangular case and LDA */
2156         PetscScalar *array;
2157         PetscReal   chop=1.e-6;
2158 
2159         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2160         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2161         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2162         for (i=0;i<n;i++) {
2163           PetscInt j;
2164           for (j=i+1;j<n;j++) {
2165             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2166             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2167             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2168           }
2169         }
2170         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2171         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2172       }
2173     } else {
2174       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2175       B = A;
2176     }
2177     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2178 
2179     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2180     if (filter) {
2181       PetscScalar *data;
2182       PetscInt    j,cum;
2183 
2184       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2185       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2186       cum = 0;
2187       for (i=0;i<n;i++) {
2188         PetscInt t;
2189 
2190         for (j=xadj[i];j<xadj[i+1];j++) {
2191           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2192             continue;
2193           }
2194           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2195         }
2196         t = xadj_filtered[i];
2197         xadj_filtered[i] = cum;
2198         cum += t;
2199       }
2200       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2201       graph->xadj = xadj_filtered;
2202       graph->adjncy = adjncy_filtered;
2203     } else {
2204       graph->xadj = xadj;
2205       graph->adjncy = adjncy;
2206     }
2207   }
2208   /* compute local connected components using PCBDDCGraph */
2209   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2210   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2211   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2212   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2213   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2214   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2215   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2216 
2217   /* partial clean up */
2218   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2219   if (B) {
2220     PetscBool flg_row;
2221     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2222     ierr = MatDestroy(&B);CHKERRQ(ierr);
2223   }
2224   if (isplex) {
2225     ierr = PetscFree(xadj);CHKERRQ(ierr);
2226     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2227   }
2228 
2229   /* get back data */
2230   if (isplex) {
2231     if (ncc) *ncc = graph->ncc;
2232     if (cc || primalv) {
2233       Mat          A;
2234       PetscBT      btv,btvt;
2235       PetscSection subSection;
2236       PetscInt     *ids,cum,cump,*cids,*pids;
2237 
2238       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2239       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2240       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2241       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2242       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2243 
2244       cids[0] = 0;
2245       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2246         PetscInt j;
2247 
2248         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2249         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2250           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2251 
2252           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2253           for (k = 0; k < 2*size; k += 2) {
2254             PetscInt s, p = closure[k], off, dof, cdof;
2255 
2256             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2257             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2258             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2259             for (s = 0; s < dof-cdof; s++) {
2260               if (PetscBTLookupSet(btvt,off+s)) continue;
2261               if (!PetscBTLookup(btv,off+s)) {
2262                 ids[cum++] = off+s;
2263               } else { /* cross-vertex */
2264                 pids[cump++] = off+s;
2265               }
2266             }
2267           }
2268           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2269         }
2270         cids[i+1] = cum;
2271         /* mark dofs as already assigned */
2272         for (j = cids[i]; j < cids[i+1]; j++) {
2273           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2274         }
2275       }
2276       if (cc) {
2277         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2278         for (i = 0; i < graph->ncc; i++) {
2279           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2280         }
2281         *cc = cc_n;
2282       }
2283       if (primalv) {
2284         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2285       }
2286       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2287       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2288       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2289     }
2290   } else {
2291     if (ncc) *ncc = graph->ncc;
2292     if (cc) {
2293       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2294       for (i=0;i<graph->ncc;i++) {
2295         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);
2296       }
2297       *cc = cc_n;
2298     }
2299     if (primalv) *primalv = NULL;
2300   }
2301   /* clean up graph */
2302   graph->xadj = 0;
2303   graph->adjncy = 0;
2304   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2305   PetscFunctionReturn(0);
2306 }
2307 
2308 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2309 {
2310   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2311   PC_IS*         pcis = (PC_IS*)(pc->data);
2312   IS             dirIS = NULL;
2313   PetscInt       i;
2314   PetscErrorCode ierr;
2315 
2316   PetscFunctionBegin;
2317   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2318   if (zerodiag) {
2319     Mat            A;
2320     Vec            vec3_N;
2321     PetscScalar    *vals;
2322     const PetscInt *idxs;
2323     PetscInt       nz,*count;
2324 
2325     /* p0 */
2326     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2327     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2328     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2329     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2330     for (i=0;i<nz;i++) vals[i] = 1.;
2331     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2332     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2333     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2334     /* v_I */
2335     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2336     for (i=0;i<nz;i++) vals[i] = 0.;
2337     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2338     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2339     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2340     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2341     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2342     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2343     if (dirIS) {
2344       PetscInt n;
2345 
2346       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2347       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2348       for (i=0;i<n;i++) vals[i] = 0.;
2349       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2350       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2351     }
2352     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2353     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2354     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2355     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2356     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2357     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2358     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2359     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]));
2360     ierr = PetscFree(vals);CHKERRQ(ierr);
2361     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2362 
2363     /* there should not be any pressure dofs lying on the interface */
2364     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2365     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2366     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2367     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2368     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2369     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]);
2370     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2371     ierr = PetscFree(count);CHKERRQ(ierr);
2372   }
2373   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2374 
2375   /* check PCBDDCBenignGetOrSetP0 */
2376   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2377   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2378   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2379   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2380   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2381   for (i=0;i<pcbddc->benign_n;i++) {
2382     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2383     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2384   }
2385   PetscFunctionReturn(0);
2386 }
2387 
2388 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2389 {
2390   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2391   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2392   PetscInt       nz,n;
2393   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2394   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2395   PetscErrorCode ierr;
2396 
2397   PetscFunctionBegin;
2398   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2399   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2400   for (n=0;n<pcbddc->benign_n;n++) {
2401     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2402   }
2403   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2404   pcbddc->benign_n = 0;
2405 
2406   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2407      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2408      Checks if all the pressure dofs in each subdomain have a zero diagonal
2409      If not, a change of basis on pressures is not needed
2410      since the local Schur complements are already SPD
2411   */
2412   has_null_pressures = PETSC_TRUE;
2413   have_null = PETSC_TRUE;
2414   if (pcbddc->n_ISForDofsLocal) {
2415     IS       iP = NULL;
2416     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2417 
2418     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2419     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2420     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2421     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2422     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2423     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2424     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2425     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2426     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2427     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2428     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2429     if (iP) {
2430       IS newpressures;
2431 
2432       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2433       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2434       pressures = newpressures;
2435     }
2436     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2437     if (!sorted) {
2438       ierr = ISSort(pressures);CHKERRQ(ierr);
2439     }
2440   } else {
2441     pressures = NULL;
2442   }
2443   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2444   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2445   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2446   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2447   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2448   if (!sorted) {
2449     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2450   }
2451   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2452   zerodiag_save = zerodiag;
2453   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2454   if (!nz) {
2455     if (n) have_null = PETSC_FALSE;
2456     has_null_pressures = PETSC_FALSE;
2457     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2458   }
2459   recompute_zerodiag = PETSC_FALSE;
2460   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2461   zerodiag_subs    = NULL;
2462   pcbddc->benign_n = 0;
2463   n_interior_dofs  = 0;
2464   interior_dofs    = NULL;
2465   nneu             = 0;
2466   if (pcbddc->NeumannBoundariesLocal) {
2467     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2468   }
2469   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2470   if (checkb) { /* need to compute interior nodes */
2471     PetscInt n,i,j;
2472     PetscInt n_neigh,*neigh,*n_shared,**shared;
2473     PetscInt *iwork;
2474 
2475     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2476     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2477     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2478     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2479     for (i=1;i<n_neigh;i++)
2480       for (j=0;j<n_shared[i];j++)
2481           iwork[shared[i][j]] += 1;
2482     for (i=0;i<n;i++)
2483       if (!iwork[i])
2484         interior_dofs[n_interior_dofs++] = i;
2485     ierr = PetscFree(iwork);CHKERRQ(ierr);
2486     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2487   }
2488   if (has_null_pressures) {
2489     IS             *subs;
2490     PetscInt       nsubs,i,j,nl;
2491     const PetscInt *idxs;
2492     PetscScalar    *array;
2493     Vec            *work;
2494     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2495 
2496     subs  = pcbddc->local_subs;
2497     nsubs = pcbddc->n_local_subs;
2498     /* 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) */
2499     if (checkb) {
2500       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2501       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2502       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2503       /* work[0] = 1_p */
2504       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2505       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2506       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2507       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2508       /* work[0] = 1_v */
2509       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2510       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2511       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2512       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2513       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2514     }
2515     if (nsubs > 1) {
2516       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2517       for (i=0;i<nsubs;i++) {
2518         ISLocalToGlobalMapping l2g;
2519         IS                     t_zerodiag_subs;
2520         PetscInt               nl;
2521 
2522         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2523         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2524         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2525         if (nl) {
2526           PetscBool valid = PETSC_TRUE;
2527 
2528           if (checkb) {
2529             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2530             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2531             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2532             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2533             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2534             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2535             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2536             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2537             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2538             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2539             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2540             for (j=0;j<n_interior_dofs;j++) {
2541               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2542                 valid = PETSC_FALSE;
2543                 break;
2544               }
2545             }
2546             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2547           }
2548           if (valid && nneu) {
2549             const PetscInt *idxs;
2550             PetscInt       nzb;
2551 
2552             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2553             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2554             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2555             if (nzb) valid = PETSC_FALSE;
2556           }
2557           if (valid && pressures) {
2558             IS t_pressure_subs;
2559             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2560             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2561             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2562           }
2563           if (valid) {
2564             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2565             pcbddc->benign_n++;
2566           } else {
2567             recompute_zerodiag = PETSC_TRUE;
2568           }
2569         }
2570         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2571         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2572       }
2573     } else { /* there's just one subdomain (or zero if they have not been detected */
2574       PetscBool valid = PETSC_TRUE;
2575 
2576       if (nneu) valid = PETSC_FALSE;
2577       if (valid && pressures) {
2578         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2579       }
2580       if (valid && checkb) {
2581         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2582         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2583         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2584         for (j=0;j<n_interior_dofs;j++) {
2585           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2586             valid = PETSC_FALSE;
2587             break;
2588           }
2589         }
2590         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2591       }
2592       if (valid) {
2593         pcbddc->benign_n = 1;
2594         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2595         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2596         zerodiag_subs[0] = zerodiag;
2597       }
2598     }
2599     if (checkb) {
2600       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2601     }
2602   }
2603   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2604 
2605   if (!pcbddc->benign_n) {
2606     PetscInt n;
2607 
2608     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2609     recompute_zerodiag = PETSC_FALSE;
2610     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2611     if (n) {
2612       has_null_pressures = PETSC_FALSE;
2613       have_null = PETSC_FALSE;
2614     }
2615   }
2616 
2617   /* final check for null pressures */
2618   if (zerodiag && pressures) {
2619     PetscInt nz,np;
2620     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2621     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2622     if (nz != np) have_null = PETSC_FALSE;
2623   }
2624 
2625   if (recompute_zerodiag) {
2626     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2627     if (pcbddc->benign_n == 1) {
2628       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2629       zerodiag = zerodiag_subs[0];
2630     } else {
2631       PetscInt i,nzn,*new_idxs;
2632 
2633       nzn = 0;
2634       for (i=0;i<pcbddc->benign_n;i++) {
2635         PetscInt ns;
2636         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2637         nzn += ns;
2638       }
2639       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2640       nzn = 0;
2641       for (i=0;i<pcbddc->benign_n;i++) {
2642         PetscInt ns,*idxs;
2643         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2644         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2645         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2646         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2647         nzn += ns;
2648       }
2649       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2650       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2651     }
2652     have_null = PETSC_FALSE;
2653   }
2654 
2655   /* Prepare matrix to compute no-net-flux */
2656   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2657     Mat                    A,loc_divudotp;
2658     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2659     IS                     row,col,isused = NULL;
2660     PetscInt               M,N,n,st,n_isused;
2661 
2662     if (pressures) {
2663       isused = pressures;
2664     } else {
2665       isused = zerodiag_save;
2666     }
2667     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2668     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2669     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2670     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");
2671     n_isused = 0;
2672     if (isused) {
2673       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2674     }
2675     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2676     st = st-n_isused;
2677     if (n) {
2678       const PetscInt *gidxs;
2679 
2680       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2681       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2682       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2683       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2684       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2685       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2686     } else {
2687       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2688       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2689       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2690     }
2691     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2692     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2693     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2694     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2695     ierr = ISDestroy(&row);CHKERRQ(ierr);
2696     ierr = ISDestroy(&col);CHKERRQ(ierr);
2697     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2698     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2699     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2700     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2701     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2702     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2703     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2704     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2705     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2706     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2707   }
2708   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2709 
2710   /* change of basis and p0 dofs */
2711   if (has_null_pressures) {
2712     IS             zerodiagc;
2713     const PetscInt *idxs,*idxsc;
2714     PetscInt       i,s,*nnz;
2715 
2716     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2717     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2718     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2719     /* local change of basis for pressures */
2720     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2721     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2722     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2723     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2724     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2725     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2726     for (i=0;i<pcbddc->benign_n;i++) {
2727       PetscInt nzs,j;
2728 
2729       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2730       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2731       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2732       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2733       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2734     }
2735     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2736     ierr = PetscFree(nnz);CHKERRQ(ierr);
2737     /* set identity on velocities */
2738     for (i=0;i<n-nz;i++) {
2739       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2740     }
2741     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2742     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2743     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2744     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2745     /* set change on pressures */
2746     for (s=0;s<pcbddc->benign_n;s++) {
2747       PetscScalar *array;
2748       PetscInt    nzs;
2749 
2750       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2751       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2752       for (i=0;i<nzs-1;i++) {
2753         PetscScalar vals[2];
2754         PetscInt    cols[2];
2755 
2756         cols[0] = idxs[i];
2757         cols[1] = idxs[nzs-1];
2758         vals[0] = 1.;
2759         vals[1] = 1.;
2760         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2761       }
2762       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2763       for (i=0;i<nzs-1;i++) array[i] = -1.;
2764       array[nzs-1] = 1.;
2765       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2766       /* store local idxs for p0 */
2767       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2768       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2769       ierr = PetscFree(array);CHKERRQ(ierr);
2770     }
2771     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2772     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2773     /* project if needed */
2774     if (pcbddc->benign_change_explicit) {
2775       Mat M;
2776 
2777       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2778       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2779       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2780       ierr = MatDestroy(&M);CHKERRQ(ierr);
2781     }
2782     /* store global idxs for p0 */
2783     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2784   }
2785   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2786   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2787 
2788   /* determines if the coarse solver will be singular or not */
2789   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2790   /* determines if the problem has subdomains with 0 pressure block */
2791   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2792   *zerodiaglocal = zerodiag;
2793   PetscFunctionReturn(0);
2794 }
2795 
2796 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2797 {
2798   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2799   PetscScalar    *array;
2800   PetscErrorCode ierr;
2801 
2802   PetscFunctionBegin;
2803   if (!pcbddc->benign_sf) {
2804     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2805     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2806   }
2807   if (get) {
2808     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2809     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2810     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2811     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2812   } else {
2813     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2814     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2815     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2816     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2817   }
2818   PetscFunctionReturn(0);
2819 }
2820 
2821 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2822 {
2823   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2824   PetscErrorCode ierr;
2825 
2826   PetscFunctionBegin;
2827   /* TODO: add error checking
2828     - avoid nested pop (or push) calls.
2829     - cannot push before pop.
2830     - cannot call this if pcbddc->local_mat is NULL
2831   */
2832   if (!pcbddc->benign_n) {
2833     PetscFunctionReturn(0);
2834   }
2835   if (pop) {
2836     if (pcbddc->benign_change_explicit) {
2837       IS       is_p0;
2838       MatReuse reuse;
2839 
2840       /* extract B_0 */
2841       reuse = MAT_INITIAL_MATRIX;
2842       if (pcbddc->benign_B0) {
2843         reuse = MAT_REUSE_MATRIX;
2844       }
2845       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2846       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2847       /* remove rows and cols from local problem */
2848       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2849       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2850       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2851       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2852     } else {
2853       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2854       PetscScalar *vals;
2855       PetscInt    i,n,*idxs_ins;
2856 
2857       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2858       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2859       if (!pcbddc->benign_B0) {
2860         PetscInt *nnz;
2861         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2862         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2863         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2864         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2865         for (i=0;i<pcbddc->benign_n;i++) {
2866           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2867           nnz[i] = n - nnz[i];
2868         }
2869         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2870         ierr = PetscFree(nnz);CHKERRQ(ierr);
2871       }
2872 
2873       for (i=0;i<pcbddc->benign_n;i++) {
2874         PetscScalar *array;
2875         PetscInt    *idxs,j,nz,cum;
2876 
2877         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2878         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2879         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2880         for (j=0;j<nz;j++) vals[j] = 1.;
2881         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2882         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2883         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2884         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2885         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2886         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2887         cum = 0;
2888         for (j=0;j<n;j++) {
2889           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2890             vals[cum] = array[j];
2891             idxs_ins[cum] = j;
2892             cum++;
2893           }
2894         }
2895         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2896         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2897         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2898       }
2899       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2900       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2901       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2902     }
2903   } else { /* push */
2904     if (pcbddc->benign_change_explicit) {
2905       PetscInt i;
2906 
2907       for (i=0;i<pcbddc->benign_n;i++) {
2908         PetscScalar *B0_vals;
2909         PetscInt    *B0_cols,B0_ncol;
2910 
2911         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2912         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2913         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2914         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2915         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2916       }
2917       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2918       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2919     } else {
2920       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2921     }
2922   }
2923   PetscFunctionReturn(0);
2924 }
2925 
2926 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2927 {
2928   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2929   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2930   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2931   PetscBLASInt    *B_iwork,*B_ifail;
2932   PetscScalar     *work,lwork;
2933   PetscScalar     *St,*S,*eigv;
2934   PetscScalar     *Sarray,*Starray;
2935   PetscReal       *eigs,thresh;
2936   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2937   PetscBool       allocated_S_St;
2938 #if defined(PETSC_USE_COMPLEX)
2939   PetscReal       *rwork;
2940 #endif
2941   PetscErrorCode  ierr;
2942 
2943   PetscFunctionBegin;
2944   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2945   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2946   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\nRerun with -sub_schurs_hermitian 1 -sub_schurs_posdef 1 if the problem is SPD",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2947 
2948   if (pcbddc->dbg_flag) {
2949     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2950     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2951     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2952     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2953   }
2954 
2955   if (pcbddc->dbg_flag) {
2956     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2957   }
2958 
2959   /* max size of subsets */
2960   mss = 0;
2961   for (i=0;i<sub_schurs->n_subs;i++) {
2962     PetscInt subset_size;
2963 
2964     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2965     mss = PetscMax(mss,subset_size);
2966   }
2967 
2968   /* min/max and threshold */
2969   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2970   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2971   nmax = PetscMax(nmin,nmax);
2972   allocated_S_St = PETSC_FALSE;
2973   if (nmin) {
2974     allocated_S_St = PETSC_TRUE;
2975   }
2976 
2977   /* allocate lapack workspace */
2978   cum = cum2 = 0;
2979   maxneigs = 0;
2980   for (i=0;i<sub_schurs->n_subs;i++) {
2981     PetscInt n,subset_size;
2982 
2983     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2984     n = PetscMin(subset_size,nmax);
2985     cum += subset_size;
2986     cum2 += subset_size*n;
2987     maxneigs = PetscMax(maxneigs,n);
2988   }
2989   if (mss) {
2990     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2991       PetscBLASInt B_itype = 1;
2992       PetscBLASInt B_N = mss;
2993       PetscReal    zero = 0.0;
2994       PetscReal    eps = 0.0; /* dlamch? */
2995 
2996       B_lwork = -1;
2997       S = NULL;
2998       St = NULL;
2999       eigs = NULL;
3000       eigv = NULL;
3001       B_iwork = NULL;
3002       B_ifail = NULL;
3003 #if defined(PETSC_USE_COMPLEX)
3004       rwork = NULL;
3005 #endif
3006       thresh = 1.0;
3007       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3008 #if defined(PETSC_USE_COMPLEX)
3009       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));
3010 #else
3011       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));
3012 #endif
3013       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3014       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3015     } else {
3016         /* TODO */
3017     }
3018   } else {
3019     lwork = 0;
3020   }
3021 
3022   nv = 0;
3023   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) */
3024     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3025   }
3026   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3027   if (allocated_S_St) {
3028     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3029   }
3030   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3031 #if defined(PETSC_USE_COMPLEX)
3032   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3033 #endif
3034   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3035                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3036                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3037                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3038                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3039   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3040 
3041   maxneigs = 0;
3042   cum = cumarray = 0;
3043   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3044   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3045   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3046     const PetscInt *idxs;
3047 
3048     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3049     for (cum=0;cum<nv;cum++) {
3050       pcbddc->adaptive_constraints_n[cum] = 1;
3051       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3052       pcbddc->adaptive_constraints_data[cum] = 1.0;
3053       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3054       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3055     }
3056     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3057   }
3058 
3059   if (mss) { /* multilevel */
3060     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3061     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3062   }
3063 
3064   thresh = pcbddc->adaptive_threshold;
3065   for (i=0;i<sub_schurs->n_subs;i++) {
3066     const PetscInt *idxs;
3067     PetscReal      upper,lower;
3068     PetscInt       j,subset_size,eigs_start = 0;
3069     PetscBLASInt   B_N;
3070     PetscBool      same_data = PETSC_FALSE;
3071 
3072     if (pcbddc->use_deluxe_scaling) {
3073       upper = PETSC_MAX_REAL;
3074       lower = thresh;
3075     } else {
3076       upper = 1./thresh;
3077       lower = 0.;
3078     }
3079     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3080     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3081     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3082     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3083       if (sub_schurs->is_hermitian) {
3084         PetscInt j,k;
3085         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3086           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3087           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3088         }
3089         for (j=0;j<subset_size;j++) {
3090           for (k=j;k<subset_size;k++) {
3091             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3092             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3093           }
3094         }
3095       } else {
3096         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3097         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3098       }
3099     } else {
3100       S = Sarray + cumarray;
3101       St = Starray + cumarray;
3102     }
3103     /* see if we can save some work */
3104     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3105       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3106     }
3107 
3108     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3109       B_neigs = 0;
3110     } else {
3111       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3112         PetscBLASInt B_itype = 1;
3113         PetscBLASInt B_IL, B_IU;
3114         PetscReal    eps = -1.0; /* dlamch? */
3115         PetscInt     nmin_s;
3116         PetscBool    compute_range = PETSC_FALSE;
3117 
3118         if (pcbddc->dbg_flag) {
3119           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
3120         }
3121 
3122         compute_range = PETSC_FALSE;
3123         if (thresh > 1.+PETSC_SMALL && !same_data) {
3124           compute_range = PETSC_TRUE;
3125         }
3126 
3127         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3128         if (compute_range) {
3129 
3130           /* ask for eigenvalues larger than thresh */
3131 #if defined(PETSC_USE_COMPLEX)
3132           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));
3133 #else
3134           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));
3135 #endif
3136         } else if (!same_data) {
3137           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3138           B_IL = 1;
3139 #if defined(PETSC_USE_COMPLEX)
3140           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));
3141 #else
3142           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));
3143 #endif
3144         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3145           PetscInt k;
3146           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3147           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3148           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3149           nmin = nmax;
3150           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3151           for (k=0;k<nmax;k++) {
3152             eigs[k] = 1./PETSC_SMALL;
3153             eigv[k*(subset_size+1)] = 1.0;
3154           }
3155         }
3156         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3157         if (B_ierr) {
3158           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3159           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);
3160           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);
3161         }
3162 
3163         if (B_neigs > nmax) {
3164           if (pcbddc->dbg_flag) {
3165             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3166           }
3167           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3168           B_neigs = nmax;
3169         }
3170 
3171         nmin_s = PetscMin(nmin,B_N);
3172         if (B_neigs < nmin_s) {
3173           PetscBLASInt B_neigs2;
3174 
3175           if (pcbddc->use_deluxe_scaling) {
3176             B_IL = B_N - nmin_s + 1;
3177             B_IU = B_N - B_neigs;
3178           } else {
3179             B_IL = B_neigs + 1;
3180             B_IU = nmin_s;
3181           }
3182           if (pcbddc->dbg_flag) {
3183             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);
3184           }
3185           if (sub_schurs->is_hermitian) {
3186             PetscInt j,k;
3187             for (j=0;j<subset_size;j++) {
3188               for (k=j;k<subset_size;k++) {
3189                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3190                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3191               }
3192             }
3193           } else {
3194             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3195             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3196           }
3197           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3198 #if defined(PETSC_USE_COMPLEX)
3199           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));
3200 #else
3201           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));
3202 #endif
3203           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3204           B_neigs += B_neigs2;
3205         }
3206         if (B_ierr) {
3207           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3208           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);
3209           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);
3210         }
3211         if (pcbddc->dbg_flag) {
3212           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3213           for (j=0;j<B_neigs;j++) {
3214             if (eigs[j] == 0.0) {
3215               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3216             } else {
3217               if (pcbddc->use_deluxe_scaling) {
3218                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3219               } else {
3220                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3221               }
3222             }
3223           }
3224         }
3225       } else {
3226           /* TODO */
3227       }
3228     }
3229     /* change the basis back to the original one */
3230     if (sub_schurs->change) {
3231       Mat change,phi,phit;
3232 
3233       if (pcbddc->dbg_flag > 1) {
3234         PetscInt ii;
3235         for (ii=0;ii<B_neigs;ii++) {
3236           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3237           for (j=0;j<B_N;j++) {
3238 #if defined(PETSC_USE_COMPLEX)
3239             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3240             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3241             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3242 #else
3243             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3244 #endif
3245           }
3246         }
3247       }
3248       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3249       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3250       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3251       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3252       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3253       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3254     }
3255     maxneigs = PetscMax(B_neigs,maxneigs);
3256     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3257     if (B_neigs) {
3258       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);
3259 
3260       if (pcbddc->dbg_flag > 1) {
3261         PetscInt ii;
3262         for (ii=0;ii<B_neigs;ii++) {
3263           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3264           for (j=0;j<B_N;j++) {
3265 #if defined(PETSC_USE_COMPLEX)
3266             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3267             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3268             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3269 #else
3270             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3271 #endif
3272           }
3273         }
3274       }
3275       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3276       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3277       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3278       cum++;
3279     }
3280     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3281     /* shift for next computation */
3282     cumarray += subset_size*subset_size;
3283   }
3284   if (pcbddc->dbg_flag) {
3285     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3286   }
3287 
3288   if (mss) {
3289     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3290     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3291     /* destroy matrices (junk) */
3292     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3293     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3294   }
3295   if (allocated_S_St) {
3296     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3297   }
3298   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3299 #if defined(PETSC_USE_COMPLEX)
3300   ierr = PetscFree(rwork);CHKERRQ(ierr);
3301 #endif
3302   if (pcbddc->dbg_flag) {
3303     PetscInt maxneigs_r;
3304     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3305     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3306   }
3307   PetscFunctionReturn(0);
3308 }
3309 
3310 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3311 {
3312   PetscScalar    *coarse_submat_vals;
3313   PetscErrorCode ierr;
3314 
3315   PetscFunctionBegin;
3316   /* Setup local scatters R_to_B and (optionally) R_to_D */
3317   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3318   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3319 
3320   /* Setup local neumann solver ksp_R */
3321   /* PCBDDCSetUpLocalScatters should be called first! */
3322   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3323 
3324   /*
3325      Setup local correction and local part of coarse basis.
3326      Gives back the dense local part of the coarse matrix in column major ordering
3327   */
3328   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3329 
3330   /* Compute total number of coarse nodes and setup coarse solver */
3331   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3332 
3333   /* free */
3334   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3335   PetscFunctionReturn(0);
3336 }
3337 
3338 PetscErrorCode PCBDDCResetCustomization(PC pc)
3339 {
3340   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3341   PetscErrorCode ierr;
3342 
3343   PetscFunctionBegin;
3344   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3345   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3346   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3347   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3348   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3349   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3350   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3351   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3352   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3353   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3354   PetscFunctionReturn(0);
3355 }
3356 
3357 PetscErrorCode PCBDDCResetTopography(PC pc)
3358 {
3359   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3360   PetscInt       i;
3361   PetscErrorCode ierr;
3362 
3363   PetscFunctionBegin;
3364   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3365   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3366   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3367   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3368   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3369   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3370   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3371   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3372   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3373   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3374   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3375   for (i=0;i<pcbddc->n_local_subs;i++) {
3376     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3377   }
3378   pcbddc->n_local_subs = 0;
3379   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3380   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3381   pcbddc->graphanalyzed        = PETSC_FALSE;
3382   pcbddc->recompute_topography = PETSC_TRUE;
3383   PetscFunctionReturn(0);
3384 }
3385 
3386 PetscErrorCode PCBDDCResetSolvers(PC pc)
3387 {
3388   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3389   PetscErrorCode ierr;
3390 
3391   PetscFunctionBegin;
3392   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3393   if (pcbddc->coarse_phi_B) {
3394     PetscScalar *array;
3395     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3396     ierr = PetscFree(array);CHKERRQ(ierr);
3397   }
3398   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3399   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3400   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3401   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3402   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3403   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3404   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3405   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3406   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3407   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3408   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3409   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3410   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3411   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3412   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3413   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3414   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3415   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3416   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3417   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3418   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3419   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3420   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3421   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3422   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3423   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3424   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3425   if (pcbddc->benign_zerodiag_subs) {
3426     PetscInt i;
3427     for (i=0;i<pcbddc->benign_n;i++) {
3428       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3429     }
3430     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3431   }
3432   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3433   PetscFunctionReturn(0);
3434 }
3435 
3436 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3437 {
3438   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3439   PC_IS          *pcis = (PC_IS*)pc->data;
3440   VecType        impVecType;
3441   PetscInt       n_constraints,n_R,old_size;
3442   PetscErrorCode ierr;
3443 
3444   PetscFunctionBegin;
3445   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3446   n_R = pcis->n - pcbddc->n_vertices;
3447   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3448   /* local work vectors (try to avoid unneeded work)*/
3449   /* R nodes */
3450   old_size = -1;
3451   if (pcbddc->vec1_R) {
3452     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3453   }
3454   if (n_R != old_size) {
3455     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3456     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3457     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3458     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3459     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3460     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3461   }
3462   /* local primal dofs */
3463   old_size = -1;
3464   if (pcbddc->vec1_P) {
3465     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3466   }
3467   if (pcbddc->local_primal_size != old_size) {
3468     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3469     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3470     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3471     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3472   }
3473   /* local explicit constraints */
3474   old_size = -1;
3475   if (pcbddc->vec1_C) {
3476     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3477   }
3478   if (n_constraints && n_constraints != old_size) {
3479     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3480     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3481     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3482     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3483   }
3484   PetscFunctionReturn(0);
3485 }
3486 
3487 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3488 {
3489   PetscErrorCode  ierr;
3490   /* pointers to pcis and pcbddc */
3491   PC_IS*          pcis = (PC_IS*)pc->data;
3492   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3493   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3494   /* submatrices of local problem */
3495   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3496   /* submatrices of local coarse problem */
3497   Mat             S_VV,S_CV,S_VC,S_CC;
3498   /* working matrices */
3499   Mat             C_CR;
3500   /* additional working stuff */
3501   PC              pc_R;
3502   Mat             F,Brhs = NULL;
3503   Vec             dummy_vec;
3504   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3505   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3506   PetscScalar     *work;
3507   PetscInt        *idx_V_B;
3508   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3509   PetscInt        i,n_R,n_D,n_B;
3510 
3511   /* some shortcuts to scalars */
3512   PetscScalar     one=1.0,m_one=-1.0;
3513 
3514   PetscFunctionBegin;
3515   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");
3516 
3517   /* Set Non-overlapping dimensions */
3518   n_vertices = pcbddc->n_vertices;
3519   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3520   n_B = pcis->n_B;
3521   n_D = pcis->n - n_B;
3522   n_R = pcis->n - n_vertices;
3523 
3524   /* vertices in boundary numbering */
3525   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3526   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3527   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3528 
3529   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3530   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3531   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3532   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3533   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3534   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3535   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3536   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3537   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3538   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3539 
3540   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3541   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3542   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3543   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3544   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3545   lda_rhs = n_R;
3546   need_benign_correction = PETSC_FALSE;
3547   if (isLU || isILU || isCHOL) {
3548     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3549   } else if (sub_schurs && sub_schurs->reuse_solver) {
3550     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3551     MatFactorType      type;
3552 
3553     F = reuse_solver->F;
3554     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3555     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3556     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3557     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3558   } else {
3559     F = NULL;
3560   }
3561 
3562   /* determine if we can use a sparse right-hand side */
3563   sparserhs = PETSC_FALSE;
3564   if (F) {
3565     const MatSolverPackage solver;
3566 
3567     ierr = MatFactorGetSolverPackage(F,&solver);CHKERRQ(ierr);
3568     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3569   }
3570 
3571   /* allocate workspace */
3572   n = 0;
3573   if (n_constraints) {
3574     n += lda_rhs*n_constraints;
3575   }
3576   if (n_vertices) {
3577     n = PetscMax(2*lda_rhs*n_vertices,n);
3578     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3579   }
3580   if (!pcbddc->symmetric_primal) {
3581     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3582   }
3583   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3584 
3585   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3586   dummy_vec = NULL;
3587   if (need_benign_correction && lda_rhs != n_R && F) {
3588     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3589   }
3590 
3591   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3592   if (n_constraints) {
3593     Mat         M1,M2,M3,C_B;
3594     IS          is_aux;
3595     PetscScalar *array,*array2;
3596 
3597     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3598     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3599 
3600     /* Extract constraints on R nodes: C_{CR}  */
3601     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3602     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3603     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3604 
3605     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3606     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3607     if (!sparserhs) {
3608       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3609       for (i=0;i<n_constraints;i++) {
3610         const PetscScalar *row_cmat_values;
3611         const PetscInt    *row_cmat_indices;
3612         PetscInt          size_of_constraint,j;
3613 
3614         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3615         for (j=0;j<size_of_constraint;j++) {
3616           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3617         }
3618         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3619       }
3620       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3621     } else {
3622       Mat tC_CR;
3623 
3624       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3625       if (lda_rhs != n_R) {
3626         PetscScalar *aa;
3627         PetscInt    r,*ii,*jj;
3628         PetscBool   done;
3629 
3630         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3631         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");CHKERRQ(ierr);
3632         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3633         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3634         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3635         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");CHKERRQ(ierr);
3636       } else {
3637         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3638         tC_CR = C_CR;
3639       }
3640       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3641       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3642     }
3643     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3644     if (F) {
3645       if (need_benign_correction) {
3646         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3647 
3648         /* rhs is already zero on interior dofs, no need to change the rhs */
3649         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3650       }
3651       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3652       if (need_benign_correction) {
3653         PetscScalar        *marr;
3654         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3655 
3656         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3657         if (lda_rhs != n_R) {
3658           for (i=0;i<n_constraints;i++) {
3659             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3660             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3661             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3662           }
3663         } else {
3664           for (i=0;i<n_constraints;i++) {
3665             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3666             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3667             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3668           }
3669         }
3670         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3671       }
3672     } else {
3673       PetscScalar *marr;
3674 
3675       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3676       for (i=0;i<n_constraints;i++) {
3677         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3678         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3679         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3680         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3681         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3682       }
3683       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3684     }
3685     if (sparserhs) {
3686       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3687     }
3688     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3689     if (!pcbddc->switch_static) {
3690       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3691       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3692       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3693       for (i=0;i<n_constraints;i++) {
3694         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3695         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3696         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3697         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3698         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3699         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3700       }
3701       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3702       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3703       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3704     } else {
3705       if (lda_rhs != n_R) {
3706         IS dummy;
3707 
3708         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3709         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3710         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3711       } else {
3712         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3713         pcbddc->local_auxmat2 = local_auxmat2_R;
3714       }
3715       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3716     }
3717     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3718     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3719     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3720     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3721     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3722     if (isCHOL) {
3723       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3724     } else {
3725       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3726     }
3727     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3728     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3729     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3730     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3731     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3732     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3733     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3734     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3735     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3736     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3737   }
3738 
3739   /* Get submatrices from subdomain matrix */
3740   if (n_vertices) {
3741     IS        is_aux;
3742     PetscBool isseqaij;
3743 
3744     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3745       IS tis;
3746 
3747       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3748       ierr = ISSort(tis);CHKERRQ(ierr);
3749       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3750       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3751     } else {
3752       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3753     }
3754     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3755     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3756     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3757     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3758       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3759     }
3760     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3761     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3762   }
3763 
3764   /* Matrix of coarse basis functions (local) */
3765   if (pcbddc->coarse_phi_B) {
3766     PetscInt on_B,on_primal,on_D=n_D;
3767     if (pcbddc->coarse_phi_D) {
3768       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3769     }
3770     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3771     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3772       PetscScalar *marray;
3773 
3774       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3775       ierr = PetscFree(marray);CHKERRQ(ierr);
3776       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3777       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3778       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3779       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3780     }
3781   }
3782 
3783   if (!pcbddc->coarse_phi_B) {
3784     PetscScalar *marr;
3785 
3786     /* memory size */
3787     n = n_B*pcbddc->local_primal_size;
3788     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3789     if (!pcbddc->symmetric_primal) n *= 2;
3790     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3791     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3792     marr += n_B*pcbddc->local_primal_size;
3793     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3794       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3795       marr += n_D*pcbddc->local_primal_size;
3796     }
3797     if (!pcbddc->symmetric_primal) {
3798       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3799       marr += n_B*pcbddc->local_primal_size;
3800       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3801         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3802       }
3803     } else {
3804       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3805       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3806       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3807         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3808         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3809       }
3810     }
3811   }
3812 
3813   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3814   p0_lidx_I = NULL;
3815   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3816     const PetscInt *idxs;
3817 
3818     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3819     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3820     for (i=0;i<pcbddc->benign_n;i++) {
3821       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3822     }
3823     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3824   }
3825 
3826   /* vertices */
3827   if (n_vertices) {
3828     PetscBool restoreavr = PETSC_FALSE;
3829 
3830     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3831 
3832     if (n_R) {
3833       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3834       PetscBLASInt B_N,B_one = 1;
3835       PetscScalar  *x,*y;
3836 
3837       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3838       if (need_benign_correction) {
3839         ISLocalToGlobalMapping RtoN;
3840         IS                     is_p0;
3841         PetscInt               *idxs_p0,n;
3842 
3843         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3844         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3845         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3846         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3847         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3848         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3849         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3850         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3851       }
3852 
3853       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3854       if (!sparserhs || need_benign_correction) {
3855         if (lda_rhs == n_R) {
3856           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3857         } else {
3858           PetscScalar    *av,*array;
3859           const PetscInt *xadj,*adjncy;
3860           PetscInt       n;
3861           PetscBool      flg_row;
3862 
3863           array = work+lda_rhs*n_vertices;
3864           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3865           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3866           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3867           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3868           for (i=0;i<n;i++) {
3869             PetscInt j;
3870             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3871           }
3872           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3873           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3874           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3875         }
3876         if (need_benign_correction) {
3877           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3878           PetscScalar        *marr;
3879 
3880           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3881           /* need \Phi^T A_RV = (I+L)A_RV, L given by
3882 
3883                  | 0 0  0 | (V)
3884              L = | 0 0 -1 | (P-p0)
3885                  | 0 0 -1 | (p0)
3886 
3887           */
3888           for (i=0;i<reuse_solver->benign_n;i++) {
3889             const PetscScalar *vals;
3890             const PetscInt    *idxs,*idxs_zero;
3891             PetscInt          n,j,nz;
3892 
3893             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3894             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3895             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3896             for (j=0;j<n;j++) {
3897               PetscScalar val = vals[j];
3898               PetscInt    k,col = idxs[j];
3899               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3900             }
3901             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3902             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3903           }
3904           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3905         }
3906         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
3907         Brhs = A_RV;
3908       } else {
3909         Mat tA_RVT,A_RVT;
3910 
3911         if (!pcbddc->symmetric_primal) {
3912           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
3913         } else {
3914           restoreavr = PETSC_TRUE;
3915           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3916           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
3917           A_RVT = A_VR;
3918         }
3919         if (lda_rhs != n_R) {
3920           PetscScalar *aa;
3921           PetscInt    r,*ii,*jj;
3922           PetscBool   done;
3923 
3924           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3925           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");CHKERRQ(ierr);
3926           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
3927           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
3928           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3929           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");CHKERRQ(ierr);
3930         } else {
3931           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
3932           tA_RVT = A_RVT;
3933         }
3934         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
3935         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
3936         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
3937       }
3938       if (F) {
3939         /* need to correct the rhs */
3940         if (need_benign_correction) {
3941           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3942           PetscScalar        *marr;
3943 
3944           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
3945           if (lda_rhs != n_R) {
3946             for (i=0;i<n_vertices;i++) {
3947               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3948               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3949               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3950             }
3951           } else {
3952             for (i=0;i<n_vertices;i++) {
3953               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3954               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3955               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3956             }
3957           }
3958           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
3959         }
3960         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
3961         if (restoreavr) {
3962           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3963         }
3964         /* need to correct the solution */
3965         if (need_benign_correction) {
3966           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3967           PetscScalar        *marr;
3968 
3969           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3970           if (lda_rhs != n_R) {
3971             for (i=0;i<n_vertices;i++) {
3972               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3973               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3974               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3975             }
3976           } else {
3977             for (i=0;i<n_vertices;i++) {
3978               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3979               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3980               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3981             }
3982           }
3983           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3984         }
3985       } else {
3986         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
3987         for (i=0;i<n_vertices;i++) {
3988           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3989           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3990           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3991           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3992           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3993         }
3994         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
3995       }
3996       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3997       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3998       /* S_VV and S_CV */
3999       if (n_constraints) {
4000         Mat B;
4001 
4002         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4003         for (i=0;i<n_vertices;i++) {
4004           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4005           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4006           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4007           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4008           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4009           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4010         }
4011         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4012         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4013         ierr = MatDestroy(&B);CHKERRQ(ierr);
4014         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4015         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4016         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4017         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4018         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4019         ierr = MatDestroy(&B);CHKERRQ(ierr);
4020       }
4021       if (lda_rhs != n_R) {
4022         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4023         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4024         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4025       }
4026       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4027       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4028       if (need_benign_correction) {
4029         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4030         PetscScalar      *marr,*sums;
4031 
4032         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4033         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4034         for (i=0;i<reuse_solver->benign_n;i++) {
4035           const PetscScalar *vals;
4036           const PetscInt    *idxs,*idxs_zero;
4037           PetscInt          n,j,nz;
4038 
4039           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4040           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4041           for (j=0;j<n_vertices;j++) {
4042             PetscInt k;
4043             sums[j] = 0.;
4044             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4045           }
4046           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4047           for (j=0;j<n;j++) {
4048             PetscScalar val = vals[j];
4049             PetscInt k;
4050             for (k=0;k<n_vertices;k++) {
4051               marr[idxs[j]+k*n_vertices] += val*sums[k];
4052             }
4053           }
4054           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4055           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4056         }
4057         ierr = PetscFree(sums);CHKERRQ(ierr);
4058         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4059         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4060       }
4061       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4062       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4063       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4064       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4065       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4066       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4067       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4068       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4069       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4070     } else {
4071       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4072     }
4073     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4074 
4075     /* coarse basis functions */
4076     for (i=0;i<n_vertices;i++) {
4077       PetscScalar *y;
4078 
4079       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4080       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4081       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4082       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4083       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4084       y[n_B*i+idx_V_B[i]] = 1.0;
4085       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4086       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4087 
4088       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4089         PetscInt j;
4090 
4091         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4092         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4093         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4094         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4095         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4096         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4097         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4098       }
4099       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4100     }
4101     /* if n_R == 0 the object is not destroyed */
4102     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4103   }
4104   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4105 
4106   if (n_constraints) {
4107     Mat B;
4108 
4109     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4110     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4111     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4112     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4113     if (n_vertices) {
4114       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4115         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4116       } else {
4117         Mat S_VCt;
4118 
4119         if (lda_rhs != n_R) {
4120           ierr = MatDestroy(&B);CHKERRQ(ierr);
4121           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4122           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4123         }
4124         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4125         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4126         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4127       }
4128     }
4129     ierr = MatDestroy(&B);CHKERRQ(ierr);
4130     /* coarse basis functions */
4131     for (i=0;i<n_constraints;i++) {
4132       PetscScalar *y;
4133 
4134       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4135       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4136       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4137       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4138       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4139       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4140       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4141       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4142         PetscInt j;
4143 
4144         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4145         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4146         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4147         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4148         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4149         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4150         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4151       }
4152       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4153     }
4154   }
4155   if (n_constraints) {
4156     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4157   }
4158   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4159 
4160   /* coarse matrix entries relative to B_0 */
4161   if (pcbddc->benign_n) {
4162     Mat         B0_B,B0_BPHI;
4163     IS          is_dummy;
4164     PetscScalar *data;
4165     PetscInt    j;
4166 
4167     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4168     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4169     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4170     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4171     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4172     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4173     for (j=0;j<pcbddc->benign_n;j++) {
4174       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4175       for (i=0;i<pcbddc->local_primal_size;i++) {
4176         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4177         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4178       }
4179     }
4180     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4181     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4182     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4183   }
4184 
4185   /* compute other basis functions for non-symmetric problems */
4186   if (!pcbddc->symmetric_primal) {
4187     Mat         B_V=NULL,B_C=NULL;
4188     PetscScalar *marray;
4189 
4190     if (n_constraints) {
4191       Mat S_CCT,C_CRT;
4192 
4193       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4194       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4195       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4196       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4197       if (n_vertices) {
4198         Mat S_VCT;
4199 
4200         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4201         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4202         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4203       }
4204       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4205     } else {
4206       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4207     }
4208     if (n_vertices && n_R) {
4209       PetscScalar    *av,*marray;
4210       const PetscInt *xadj,*adjncy;
4211       PetscInt       n;
4212       PetscBool      flg_row;
4213 
4214       /* B_V = B_V - A_VR^T */
4215       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4216       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4217       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4218       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4219       for (i=0;i<n;i++) {
4220         PetscInt j;
4221         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4222       }
4223       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4224       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4225       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4226     }
4227 
4228     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4229     if (n_vertices) {
4230       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4231       for (i=0;i<n_vertices;i++) {
4232         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4233         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4234         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4235         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4236         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4237       }
4238       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4239     }
4240     if (B_C) {
4241       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4242       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4243         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4244         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4245         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4246         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4247         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4248       }
4249       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4250     }
4251     /* coarse basis functions */
4252     for (i=0;i<pcbddc->local_primal_size;i++) {
4253       PetscScalar *y;
4254 
4255       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4256       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4257       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4258       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4259       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4260       if (i<n_vertices) {
4261         y[n_B*i+idx_V_B[i]] = 1.0;
4262       }
4263       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4264       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4265 
4266       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4267         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4268         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4269         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4270         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4271         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4272         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4273       }
4274       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4275     }
4276     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4277     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4278   }
4279 
4280   /* free memory */
4281   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4282   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4283   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4284   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4285   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4286   ierr = PetscFree(work);CHKERRQ(ierr);
4287   if (n_vertices) {
4288     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4289   }
4290   if (n_constraints) {
4291     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4292   }
4293   /* Checking coarse_sub_mat and coarse basis functios */
4294   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4295   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4296   if (pcbddc->dbg_flag) {
4297     Mat         coarse_sub_mat;
4298     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4299     Mat         coarse_phi_D,coarse_phi_B;
4300     Mat         coarse_psi_D,coarse_psi_B;
4301     Mat         A_II,A_BB,A_IB,A_BI;
4302     Mat         C_B,CPHI;
4303     IS          is_dummy;
4304     Vec         mones;
4305     MatType     checkmattype=MATSEQAIJ;
4306     PetscReal   real_value;
4307 
4308     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4309       Mat A;
4310       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4311       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4312       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4313       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4314       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4315       ierr = MatDestroy(&A);CHKERRQ(ierr);
4316     } else {
4317       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4318       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4319       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4320       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4321     }
4322     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4323     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4324     if (!pcbddc->symmetric_primal) {
4325       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4326       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4327     }
4328     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4329 
4330     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4331     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4332     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4333     if (!pcbddc->symmetric_primal) {
4334       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4335       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4336       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4337       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4338       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4339       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4340       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4341       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4342       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4343       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4344       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4345       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4346     } else {
4347       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4348       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4349       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4350       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4351       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4352       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4353       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4354       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4355     }
4356     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4357     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4358     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4359     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4360     if (pcbddc->benign_n) {
4361       Mat         B0_B,B0_BPHI;
4362       PetscScalar *data,*data2;
4363       PetscInt    j;
4364 
4365       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4366       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4367       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4368       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4369       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4370       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4371       for (j=0;j<pcbddc->benign_n;j++) {
4372         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4373         for (i=0;i<pcbddc->local_primal_size;i++) {
4374           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4375           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4376         }
4377       }
4378       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4379       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4380       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4381       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4382       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4383     }
4384 #if 0
4385   {
4386     PetscViewer viewer;
4387     char filename[256];
4388     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4389     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4390     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4391     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4392     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4393     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4394     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4395     if (save_change) {
4396       Mat phi_B;
4397       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4398       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4399       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4400       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4401     } else {
4402       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4403       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4404     }
4405     if (pcbddc->coarse_phi_D) {
4406       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4407       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4408     }
4409     if (pcbddc->coarse_psi_B) {
4410       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4411       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4412     }
4413     if (pcbddc->coarse_psi_D) {
4414       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4415       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4416     }
4417     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4418   }
4419 #endif
4420     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4421     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4422     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4423     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4424 
4425     /* check constraints */
4426     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4427     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4428     if (!pcbddc->benign_n) { /* TODO: add benign case */
4429       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4430     } else {
4431       PetscScalar *data;
4432       Mat         tmat;
4433       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4434       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4435       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4436       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4437       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4438     }
4439     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4440     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4441     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4442     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4443     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4444     if (!pcbddc->symmetric_primal) {
4445       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4446       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4447       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4448       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4449       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4450     }
4451     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4452     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4453     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4454     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4455     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4456     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4457     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4458     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4459     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4460     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4461     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4462     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4463     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4464     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4465     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4466     if (!pcbddc->symmetric_primal) {
4467       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4468       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4469     }
4470     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4471   }
4472   /* get back data */
4473   *coarse_submat_vals_n = coarse_submat_vals;
4474   PetscFunctionReturn(0);
4475 }
4476 
4477 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4478 {
4479   Mat            *work_mat;
4480   IS             isrow_s,iscol_s;
4481   PetscBool      rsorted,csorted;
4482   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4483   PetscErrorCode ierr;
4484 
4485   PetscFunctionBegin;
4486   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4487   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4488   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4489   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4490 
4491   if (!rsorted) {
4492     const PetscInt *idxs;
4493     PetscInt *idxs_sorted,i;
4494 
4495     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4496     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4497     for (i=0;i<rsize;i++) {
4498       idxs_perm_r[i] = i;
4499     }
4500     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4501     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4502     for (i=0;i<rsize;i++) {
4503       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4504     }
4505     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4506     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4507   } else {
4508     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4509     isrow_s = isrow;
4510   }
4511 
4512   if (!csorted) {
4513     if (isrow == iscol) {
4514       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4515       iscol_s = isrow_s;
4516     } else {
4517       const PetscInt *idxs;
4518       PetscInt       *idxs_sorted,i;
4519 
4520       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4521       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4522       for (i=0;i<csize;i++) {
4523         idxs_perm_c[i] = i;
4524       }
4525       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4526       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4527       for (i=0;i<csize;i++) {
4528         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4529       }
4530       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4531       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4532     }
4533   } else {
4534     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4535     iscol_s = iscol;
4536   }
4537 
4538   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4539 
4540   if (!rsorted || !csorted) {
4541     Mat      new_mat;
4542     IS       is_perm_r,is_perm_c;
4543 
4544     if (!rsorted) {
4545       PetscInt *idxs_r,i;
4546       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4547       for (i=0;i<rsize;i++) {
4548         idxs_r[idxs_perm_r[i]] = i;
4549       }
4550       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4551       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4552     } else {
4553       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4554     }
4555     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4556 
4557     if (!csorted) {
4558       if (isrow_s == iscol_s) {
4559         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4560         is_perm_c = is_perm_r;
4561       } else {
4562         PetscInt *idxs_c,i;
4563         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4564         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4565         for (i=0;i<csize;i++) {
4566           idxs_c[idxs_perm_c[i]] = i;
4567         }
4568         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4569         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4570       }
4571     } else {
4572       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4573     }
4574     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4575 
4576     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4577     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4578     work_mat[0] = new_mat;
4579     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4580     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4581   }
4582 
4583   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4584   *B = work_mat[0];
4585   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4586   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4587   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4588   PetscFunctionReturn(0);
4589 }
4590 
4591 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4592 {
4593   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4594   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4595   Mat            new_mat,lA;
4596   IS             is_local,is_global;
4597   PetscInt       local_size;
4598   PetscBool      isseqaij;
4599   PetscErrorCode ierr;
4600 
4601   PetscFunctionBegin;
4602   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4603   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4604   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4605   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4606   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4607   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4608   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4609 
4610   /* check */
4611   if (pcbddc->dbg_flag) {
4612     Vec       x,x_change;
4613     PetscReal error;
4614 
4615     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4616     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4617     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4618     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4619     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4620     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4621     if (!pcbddc->change_interior) {
4622       const PetscScalar *x,*y,*v;
4623       PetscReal         lerror = 0.;
4624       PetscInt          i;
4625 
4626       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4627       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4628       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4629       for (i=0;i<local_size;i++)
4630         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4631           lerror = PetscAbsScalar(x[i]-y[i]);
4632       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4633       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4634       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4635       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4636       if (error > PETSC_SMALL) {
4637         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4638           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4639         } else {
4640           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4641         }
4642       }
4643     }
4644     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4645     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4646     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4647     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4648     if (error > PETSC_SMALL) {
4649       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4650         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4651       } else {
4652         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4653       }
4654     }
4655     ierr = VecDestroy(&x);CHKERRQ(ierr);
4656     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4657   }
4658 
4659   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4660   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4661 
4662   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4663   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4664   if (isseqaij) {
4665     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4666     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4667     if (lA) {
4668       Mat work;
4669       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4670       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4671       ierr = MatDestroy(&work);CHKERRQ(ierr);
4672     }
4673   } else {
4674     Mat work_mat;
4675 
4676     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4677     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4678     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4679     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4680     if (lA) {
4681       Mat work;
4682       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4683       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4684       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4685       ierr = MatDestroy(&work);CHKERRQ(ierr);
4686     }
4687   }
4688   if (matis->A->symmetric_set) {
4689     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4690 #if !defined(PETSC_USE_COMPLEX)
4691     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4692 #endif
4693   }
4694   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4695   PetscFunctionReturn(0);
4696 }
4697 
4698 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4699 {
4700   PC_IS*          pcis = (PC_IS*)(pc->data);
4701   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4702   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4703   PetscInt        *idx_R_local=NULL;
4704   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4705   PetscInt        vbs,bs;
4706   PetscBT         bitmask=NULL;
4707   PetscErrorCode  ierr;
4708 
4709   PetscFunctionBegin;
4710   /*
4711     No need to setup local scatters if
4712       - primal space is unchanged
4713         AND
4714       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4715         AND
4716       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4717   */
4718   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4719     PetscFunctionReturn(0);
4720   }
4721   /* destroy old objects */
4722   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4723   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4724   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4725   /* Set Non-overlapping dimensions */
4726   n_B = pcis->n_B;
4727   n_D = pcis->n - n_B;
4728   n_vertices = pcbddc->n_vertices;
4729 
4730   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4731 
4732   /* create auxiliary bitmask and allocate workspace */
4733   if (!sub_schurs || !sub_schurs->reuse_solver) {
4734     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4735     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4736     for (i=0;i<n_vertices;i++) {
4737       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4738     }
4739 
4740     for (i=0, n_R=0; i<pcis->n; i++) {
4741       if (!PetscBTLookup(bitmask,i)) {
4742         idx_R_local[n_R++] = i;
4743       }
4744     }
4745   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4746     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4747 
4748     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4749     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4750   }
4751 
4752   /* Block code */
4753   vbs = 1;
4754   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4755   if (bs>1 && !(n_vertices%bs)) {
4756     PetscBool is_blocked = PETSC_TRUE;
4757     PetscInt  *vary;
4758     if (!sub_schurs || !sub_schurs->reuse_solver) {
4759       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4760       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4761       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4762       /* 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 */
4763       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4764       for (i=0; i<pcis->n/bs; i++) {
4765         if (vary[i]!=0 && vary[i]!=bs) {
4766           is_blocked = PETSC_FALSE;
4767           break;
4768         }
4769       }
4770       ierr = PetscFree(vary);CHKERRQ(ierr);
4771     } else {
4772       /* Verify directly the R set */
4773       for (i=0; i<n_R/bs; i++) {
4774         PetscInt j,node=idx_R_local[bs*i];
4775         for (j=1; j<bs; j++) {
4776           if (node != idx_R_local[bs*i+j]-j) {
4777             is_blocked = PETSC_FALSE;
4778             break;
4779           }
4780         }
4781       }
4782     }
4783     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4784       vbs = bs;
4785       for (i=0;i<n_R/vbs;i++) {
4786         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4787       }
4788     }
4789   }
4790   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4791   if (sub_schurs && sub_schurs->reuse_solver) {
4792     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4793 
4794     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4795     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4796     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4797     reuse_solver->is_R = pcbddc->is_R_local;
4798   } else {
4799     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4800   }
4801 
4802   /* print some info if requested */
4803   if (pcbddc->dbg_flag) {
4804     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4805     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4806     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4807     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4808     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4809     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);
4810     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4811   }
4812 
4813   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4814   if (!sub_schurs || !sub_schurs->reuse_solver) {
4815     IS       is_aux1,is_aux2;
4816     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4817 
4818     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4819     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4820     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4821     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4822     for (i=0; i<n_D; i++) {
4823       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4824     }
4825     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4826     for (i=0, j=0; i<n_R; i++) {
4827       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4828         aux_array1[j++] = i;
4829       }
4830     }
4831     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4832     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4833     for (i=0, j=0; i<n_B; i++) {
4834       if (!PetscBTLookup(bitmask,is_indices[i])) {
4835         aux_array2[j++] = i;
4836       }
4837     }
4838     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4839     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4840     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4841     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4842     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4843 
4844     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4845       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4846       for (i=0, j=0; i<n_R; i++) {
4847         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4848           aux_array1[j++] = i;
4849         }
4850       }
4851       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4852       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4853       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4854     }
4855     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4856     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4857   } else {
4858     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4859     IS                 tis;
4860     PetscInt           schur_size;
4861 
4862     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4863     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4864     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4865     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4866     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4867       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4868       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4869       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4870     }
4871   }
4872   PetscFunctionReturn(0);
4873 }
4874 
4875 
4876 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4877 {
4878   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4879   PC_IS          *pcis = (PC_IS*)pc->data;
4880   PC             pc_temp;
4881   Mat            A_RR;
4882   MatReuse       reuse;
4883   PetscScalar    m_one = -1.0;
4884   PetscReal      value;
4885   PetscInt       n_D,n_R;
4886   PetscBool      check_corr[2],issbaij;
4887   PetscErrorCode ierr;
4888   /* prefixes stuff */
4889   char           dir_prefix[256],neu_prefix[256],str_level[16];
4890   size_t         len;
4891 
4892   PetscFunctionBegin;
4893 
4894   /* compute prefixes */
4895   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4896   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4897   if (!pcbddc->current_level) {
4898     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4899     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4900     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4901     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4902   } else {
4903     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4904     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4905     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4906     len -= 15; /* remove "pc_bddc_coarse_" */
4907     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4908     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4909     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4910     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4911     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4912     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4913     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4914     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4915   }
4916 
4917   /* DIRICHLET PROBLEM */
4918   if (dirichlet) {
4919     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4920     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4921       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4922       if (pcbddc->dbg_flag) {
4923         Mat    A_IIn;
4924 
4925         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4926         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4927         pcis->A_II = A_IIn;
4928       }
4929     }
4930     if (pcbddc->local_mat->symmetric_set) {
4931       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4932     }
4933     /* Matrix for Dirichlet problem is pcis->A_II */
4934     n_D = pcis->n - pcis->n_B;
4935     if (!pcbddc->ksp_D) { /* create object if not yet build */
4936       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4937       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4938       /* default */
4939       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4940       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4941       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4942       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4943       if (issbaij) {
4944         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4945       } else {
4946         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4947       }
4948       /* Allow user's customization */
4949       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4950       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4951     }
4952     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4953     if (sub_schurs && sub_schurs->reuse_solver) {
4954       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4955 
4956       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4957     }
4958     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4959     if (!n_D) {
4960       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4961       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4962     }
4963     /* Set Up KSP for Dirichlet problem of BDDC */
4964     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4965     /* set ksp_D into pcis data */
4966     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4967     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4968     pcis->ksp_D = pcbddc->ksp_D;
4969   }
4970 
4971   /* NEUMANN PROBLEM */
4972   A_RR = 0;
4973   if (neumann) {
4974     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4975     PetscInt        ibs,mbs;
4976     PetscBool       issbaij, reuse_neumann_solver;
4977     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4978 
4979     reuse_neumann_solver = PETSC_FALSE;
4980     if (sub_schurs && sub_schurs->reuse_solver) {
4981       IS iP;
4982 
4983       reuse_neumann_solver = PETSC_TRUE;
4984       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
4985       if (iP) reuse_neumann_solver = PETSC_FALSE;
4986     }
4987     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4988     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4989     if (pcbddc->ksp_R) { /* already created ksp */
4990       PetscInt nn_R;
4991       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4992       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4993       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4994       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4995         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4996         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4997         reuse = MAT_INITIAL_MATRIX;
4998       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4999         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5000           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5001           reuse = MAT_INITIAL_MATRIX;
5002         } else { /* safe to reuse the matrix */
5003           reuse = MAT_REUSE_MATRIX;
5004         }
5005       }
5006       /* last check */
5007       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5008         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5009         reuse = MAT_INITIAL_MATRIX;
5010       }
5011     } else { /* first time, so we need to create the matrix */
5012       reuse = MAT_INITIAL_MATRIX;
5013     }
5014     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5015     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5016     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5017     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5018     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5019       if (matis->A == pcbddc->local_mat) {
5020         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5021         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5022       } else {
5023         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5024       }
5025     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5026       if (matis->A == pcbddc->local_mat) {
5027         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5028         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5029       } else {
5030         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5031       }
5032     }
5033     /* extract A_RR */
5034     if (reuse_neumann_solver) {
5035       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5036 
5037       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5038         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5039         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5040           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5041         } else {
5042           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5043         }
5044       } else {
5045         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5046         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5047         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5048       }
5049     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5050       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5051     }
5052     if (pcbddc->local_mat->symmetric_set) {
5053       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5054     }
5055     if (!pcbddc->ksp_R) { /* create object if not present */
5056       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5057       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5058       /* default */
5059       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5060       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5061       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5062       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5063       if (issbaij) {
5064         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5065       } else {
5066         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5067       }
5068       /* Allow user's customization */
5069       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5070       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
5071     }
5072     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5073     if (!n_R) {
5074       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5075       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5076     }
5077     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5078     /* Reuse solver if it is present */
5079     if (reuse_neumann_solver) {
5080       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5081 
5082       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5083     }
5084     /* Set Up KSP for Neumann problem of BDDC */
5085     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5086   }
5087 
5088   if (pcbddc->dbg_flag) {
5089     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5090     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5091     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5092   }
5093 
5094   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5095   check_corr[0] = check_corr[1] = PETSC_FALSE;
5096   if (pcbddc->NullSpace_corr[0]) {
5097     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5098   }
5099   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5100     check_corr[0] = PETSC_TRUE;
5101     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5102   }
5103   if (neumann && pcbddc->NullSpace_corr[2]) {
5104     check_corr[1] = PETSC_TRUE;
5105     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5106   }
5107 
5108   /* check Dirichlet and Neumann solvers */
5109   if (pcbddc->dbg_flag) {
5110     if (dirichlet) { /* Dirichlet */
5111       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5112       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5113       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5114       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5115       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5116       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);
5117       if (check_corr[0]) {
5118         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5119       }
5120       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5121     }
5122     if (neumann) { /* Neumann */
5123       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5124       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5125       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5126       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5127       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5128       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);
5129       if (check_corr[1]) {
5130         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5131       }
5132       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5133     }
5134   }
5135   /* free Neumann problem's matrix */
5136   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5137   PetscFunctionReturn(0);
5138 }
5139 
5140 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5141 {
5142   PetscErrorCode  ierr;
5143   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5144   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5145   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5146 
5147   PetscFunctionBegin;
5148   if (!reuse_solver) {
5149     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5150   }
5151   if (!pcbddc->switch_static) {
5152     if (applytranspose && pcbddc->local_auxmat1) {
5153       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5154       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5155     }
5156     if (!reuse_solver) {
5157       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5158       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5159     } else {
5160       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5161 
5162       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5163       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5164     }
5165   } else {
5166     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5167     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5168     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5169     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5170     if (applytranspose && pcbddc->local_auxmat1) {
5171       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5172       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5173       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5174       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5175     }
5176   }
5177   if (!reuse_solver || pcbddc->switch_static) {
5178     if (applytranspose) {
5179       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5180     } else {
5181       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5182     }
5183   } else {
5184     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5185 
5186     if (applytranspose) {
5187       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5188     } else {
5189       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5190     }
5191   }
5192   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5193   if (!pcbddc->switch_static) {
5194     if (!reuse_solver) {
5195       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5196       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5197     } else {
5198       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5199 
5200       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5201       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5202     }
5203     if (!applytranspose && pcbddc->local_auxmat1) {
5204       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5205       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5206     }
5207   } else {
5208     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5209     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5210     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5211     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5212     if (!applytranspose && pcbddc->local_auxmat1) {
5213       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5214       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5215     }
5216     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5217     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5218     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5219     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5220   }
5221   PetscFunctionReturn(0);
5222 }
5223 
5224 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5225 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5226 {
5227   PetscErrorCode ierr;
5228   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5229   PC_IS*            pcis = (PC_IS*)  (pc->data);
5230   const PetscScalar zero = 0.0;
5231 
5232   PetscFunctionBegin;
5233   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5234   if (!pcbddc->benign_apply_coarse_only) {
5235     if (applytranspose) {
5236       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5237       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5238     } else {
5239       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5240       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5241     }
5242   } else {
5243     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5244   }
5245 
5246   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5247   if (pcbddc->benign_n) {
5248     PetscScalar *array;
5249     PetscInt    j;
5250 
5251     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5252     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5253     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5254   }
5255 
5256   /* start communications from local primal nodes to rhs of coarse solver */
5257   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5258   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5259   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5260 
5261   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5262   if (pcbddc->coarse_ksp) {
5263     Mat          coarse_mat;
5264     Vec          rhs,sol;
5265     MatNullSpace nullsp;
5266     PetscBool    isbddc = PETSC_FALSE;
5267 
5268     if (pcbddc->benign_have_null) {
5269       PC        coarse_pc;
5270 
5271       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5272       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5273       /* we need to propagate to coarser levels the need for a possible benign correction */
5274       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5275         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5276         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5277         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5278       }
5279     }
5280     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5281     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5282     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5283     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5284     if (nullsp) {
5285       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5286     }
5287     if (applytranspose) {
5288       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5289       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5290     } else {
5291       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5292         PC        coarse_pc;
5293 
5294         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5295         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5296         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5297         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5298       } else {
5299         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5300       }
5301     }
5302     /* we don't need the benign correction at coarser levels anymore */
5303     if (pcbddc->benign_have_null && isbddc) {
5304       PC        coarse_pc;
5305       PC_BDDC*  coarsepcbddc;
5306 
5307       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5308       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5309       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5310       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5311     }
5312     if (nullsp) {
5313       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5314     }
5315   }
5316 
5317   /* Local solution on R nodes */
5318   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5319     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5320   }
5321   /* communications from coarse sol to local primal nodes */
5322   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5323   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5324 
5325   /* Sum contributions from the two levels */
5326   if (!pcbddc->benign_apply_coarse_only) {
5327     if (applytranspose) {
5328       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5329       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5330     } else {
5331       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5332       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5333     }
5334     /* store p0 */
5335     if (pcbddc->benign_n) {
5336       PetscScalar *array;
5337       PetscInt    j;
5338 
5339       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5340       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5341       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5342     }
5343   } else { /* expand the coarse solution */
5344     if (applytranspose) {
5345       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5346     } else {
5347       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5348     }
5349   }
5350   PetscFunctionReturn(0);
5351 }
5352 
5353 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5354 {
5355   PetscErrorCode ierr;
5356   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5357   PetscScalar    *array;
5358   Vec            from,to;
5359 
5360   PetscFunctionBegin;
5361   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5362     from = pcbddc->coarse_vec;
5363     to = pcbddc->vec1_P;
5364     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5365       Vec tvec;
5366 
5367       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5368       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5369       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5370       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5371       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5372       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5373     }
5374   } else { /* from local to global -> put data in coarse right hand side */
5375     from = pcbddc->vec1_P;
5376     to = pcbddc->coarse_vec;
5377   }
5378   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5379   PetscFunctionReturn(0);
5380 }
5381 
5382 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5383 {
5384   PetscErrorCode ierr;
5385   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5386   PetscScalar    *array;
5387   Vec            from,to;
5388 
5389   PetscFunctionBegin;
5390   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5391     from = pcbddc->coarse_vec;
5392     to = pcbddc->vec1_P;
5393   } else { /* from local to global -> put data in coarse right hand side */
5394     from = pcbddc->vec1_P;
5395     to = pcbddc->coarse_vec;
5396   }
5397   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5398   if (smode == SCATTER_FORWARD) {
5399     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5400       Vec tvec;
5401 
5402       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5403       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5404       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5405       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5406     }
5407   } else {
5408     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5409      ierr = VecResetArray(from);CHKERRQ(ierr);
5410     }
5411   }
5412   PetscFunctionReturn(0);
5413 }
5414 
5415 /* uncomment for testing purposes */
5416 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5417 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5418 {
5419   PetscErrorCode    ierr;
5420   PC_IS*            pcis = (PC_IS*)(pc->data);
5421   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5422   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5423   /* one and zero */
5424   PetscScalar       one=1.0,zero=0.0;
5425   /* space to store constraints and their local indices */
5426   PetscScalar       *constraints_data;
5427   PetscInt          *constraints_idxs,*constraints_idxs_B;
5428   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5429   PetscInt          *constraints_n;
5430   /* iterators */
5431   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5432   /* BLAS integers */
5433   PetscBLASInt      lwork,lierr;
5434   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5435   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5436   /* reuse */
5437   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5438   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5439   /* change of basis */
5440   PetscBool         qr_needed;
5441   PetscBT           change_basis,qr_needed_idx;
5442   /* auxiliary stuff */
5443   PetscInt          *nnz,*is_indices;
5444   PetscInt          ncc;
5445   /* some quantities */
5446   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5447   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5448 
5449   PetscFunctionBegin;
5450   /* Destroy Mat objects computed previously */
5451   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5452   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5453   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5454   /* save info on constraints from previous setup (if any) */
5455   olocal_primal_size = pcbddc->local_primal_size;
5456   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5457   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5458   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5459   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5460   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5461   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5462 
5463   if (!pcbddc->adaptive_selection) {
5464     IS           ISForVertices,*ISForFaces,*ISForEdges;
5465     MatNullSpace nearnullsp;
5466     const Vec    *nearnullvecs;
5467     Vec          *localnearnullsp;
5468     PetscScalar  *array;
5469     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5470     PetscBool    nnsp_has_cnst;
5471     /* LAPACK working arrays for SVD or POD */
5472     PetscBool    skip_lapack,boolforchange;
5473     PetscScalar  *work;
5474     PetscReal    *singular_vals;
5475 #if defined(PETSC_USE_COMPLEX)
5476     PetscReal    *rwork;
5477 #endif
5478 #if defined(PETSC_MISSING_LAPACK_GESVD)
5479     PetscScalar  *temp_basis,*correlation_mat;
5480 #else
5481     PetscBLASInt dummy_int=1;
5482     PetscScalar  dummy_scalar=1.;
5483 #endif
5484 
5485     /* Get index sets for faces, edges and vertices from graph */
5486     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5487     /* print some info */
5488     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5489       PetscInt nv;
5490 
5491       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5492       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5493       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5494       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5495       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5496       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5497       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5498       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5499       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5500     }
5501 
5502     /* free unneeded index sets */
5503     if (!pcbddc->use_vertices) {
5504       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5505     }
5506     if (!pcbddc->use_edges) {
5507       for (i=0;i<n_ISForEdges;i++) {
5508         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5509       }
5510       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5511       n_ISForEdges = 0;
5512     }
5513     if (!pcbddc->use_faces) {
5514       for (i=0;i<n_ISForFaces;i++) {
5515         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5516       }
5517       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5518       n_ISForFaces = 0;
5519     }
5520 
5521     /* check if near null space is attached to global mat */
5522     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5523     if (nearnullsp) {
5524       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5525       /* remove any stored info */
5526       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5527       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5528       /* store information for BDDC solver reuse */
5529       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5530       pcbddc->onearnullspace = nearnullsp;
5531       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5532       for (i=0;i<nnsp_size;i++) {
5533         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5534       }
5535     } else { /* if near null space is not provided BDDC uses constants by default */
5536       nnsp_size = 0;
5537       nnsp_has_cnst = PETSC_TRUE;
5538     }
5539     /* get max number of constraints on a single cc */
5540     max_constraints = nnsp_size;
5541     if (nnsp_has_cnst) max_constraints++;
5542 
5543     /*
5544          Evaluate maximum storage size needed by the procedure
5545          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5546          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5547          There can be multiple constraints per connected component
5548                                                                                                                                                            */
5549     n_vertices = 0;
5550     if (ISForVertices) {
5551       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5552     }
5553     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5554     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5555 
5556     total_counts = n_ISForFaces+n_ISForEdges;
5557     total_counts *= max_constraints;
5558     total_counts += n_vertices;
5559     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5560 
5561     total_counts = 0;
5562     max_size_of_constraint = 0;
5563     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5564       IS used_is;
5565       if (i<n_ISForEdges) {
5566         used_is = ISForEdges[i];
5567       } else {
5568         used_is = ISForFaces[i-n_ISForEdges];
5569       }
5570       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5571       total_counts += j;
5572       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5573     }
5574     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);
5575 
5576     /* get local part of global near null space vectors */
5577     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5578     for (k=0;k<nnsp_size;k++) {
5579       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5580       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5581       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5582     }
5583 
5584     /* whether or not to skip lapack calls */
5585     skip_lapack = PETSC_TRUE;
5586     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5587 
5588     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5589     if (!skip_lapack) {
5590       PetscScalar temp_work;
5591 
5592 #if defined(PETSC_MISSING_LAPACK_GESVD)
5593       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5594       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5595       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5596       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5597 #if defined(PETSC_USE_COMPLEX)
5598       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5599 #endif
5600       /* now we evaluate the optimal workspace using query with lwork=-1 */
5601       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5602       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5603       lwork = -1;
5604       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5605 #if !defined(PETSC_USE_COMPLEX)
5606       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5607 #else
5608       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5609 #endif
5610       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5611       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5612 #else /* on missing GESVD */
5613       /* SVD */
5614       PetscInt max_n,min_n;
5615       max_n = max_size_of_constraint;
5616       min_n = max_constraints;
5617       if (max_size_of_constraint < max_constraints) {
5618         min_n = max_size_of_constraint;
5619         max_n = max_constraints;
5620       }
5621       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5622 #if defined(PETSC_USE_COMPLEX)
5623       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5624 #endif
5625       /* now we evaluate the optimal workspace using query with lwork=-1 */
5626       lwork = -1;
5627       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5628       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5629       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5630       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5631 #if !defined(PETSC_USE_COMPLEX)
5632       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));
5633 #else
5634       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));
5635 #endif
5636       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5637       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5638 #endif /* on missing GESVD */
5639       /* Allocate optimal workspace */
5640       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5641       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5642     }
5643     /* Now we can loop on constraining sets */
5644     total_counts = 0;
5645     constraints_idxs_ptr[0] = 0;
5646     constraints_data_ptr[0] = 0;
5647     /* vertices */
5648     if (n_vertices) {
5649       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5650       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5651       for (i=0;i<n_vertices;i++) {
5652         constraints_n[total_counts] = 1;
5653         constraints_data[total_counts] = 1.0;
5654         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5655         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5656         total_counts++;
5657       }
5658       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5659       n_vertices = total_counts;
5660     }
5661 
5662     /* edges and faces */
5663     total_counts_cc = total_counts;
5664     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5665       IS        used_is;
5666       PetscBool idxs_copied = PETSC_FALSE;
5667 
5668       if (ncc<n_ISForEdges) {
5669         used_is = ISForEdges[ncc];
5670         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5671       } else {
5672         used_is = ISForFaces[ncc-n_ISForEdges];
5673         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5674       }
5675       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5676 
5677       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5678       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5679       /* change of basis should not be performed on local periodic nodes */
5680       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5681       if (nnsp_has_cnst) {
5682         PetscScalar quad_value;
5683 
5684         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5685         idxs_copied = PETSC_TRUE;
5686 
5687         if (!pcbddc->use_nnsp_true) {
5688           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5689         } else {
5690           quad_value = 1.0;
5691         }
5692         for (j=0;j<size_of_constraint;j++) {
5693           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5694         }
5695         temp_constraints++;
5696         total_counts++;
5697       }
5698       for (k=0;k<nnsp_size;k++) {
5699         PetscReal real_value;
5700         PetscScalar *ptr_to_data;
5701 
5702         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5703         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5704         for (j=0;j<size_of_constraint;j++) {
5705           ptr_to_data[j] = array[is_indices[j]];
5706         }
5707         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5708         /* check if array is null on the connected component */
5709         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5710         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5711         if (real_value > 0.0) { /* keep indices and values */
5712           temp_constraints++;
5713           total_counts++;
5714           if (!idxs_copied) {
5715             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5716             idxs_copied = PETSC_TRUE;
5717           }
5718         }
5719       }
5720       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5721       valid_constraints = temp_constraints;
5722       if (!pcbddc->use_nnsp_true && temp_constraints) {
5723         if (temp_constraints == 1) { /* just normalize the constraint */
5724           PetscScalar norm,*ptr_to_data;
5725 
5726           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5727           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5728           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5729           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5730           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5731         } else { /* perform SVD */
5732           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5733           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5734 
5735 #if defined(PETSC_MISSING_LAPACK_GESVD)
5736           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5737              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5738              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5739                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5740                 from that computed using LAPACKgesvd
5741              -> This is due to a different computation of eigenvectors in LAPACKheev
5742              -> The quality of the POD-computed basis will be the same */
5743           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5744           /* Store upper triangular part of correlation matrix */
5745           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5746           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5747           for (j=0;j<temp_constraints;j++) {
5748             for (k=0;k<j+1;k++) {
5749               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));
5750             }
5751           }
5752           /* compute eigenvalues and eigenvectors of correlation matrix */
5753           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5754           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5755 #if !defined(PETSC_USE_COMPLEX)
5756           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5757 #else
5758           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5759 #endif
5760           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5761           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5762           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5763           j = 0;
5764           while (j < temp_constraints && singular_vals[j] < tol) j++;
5765           total_counts = total_counts-j;
5766           valid_constraints = temp_constraints-j;
5767           /* scale and copy POD basis into used quadrature memory */
5768           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5769           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5770           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5771           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5772           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5773           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5774           if (j<temp_constraints) {
5775             PetscInt ii;
5776             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5777             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5778             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));
5779             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5780             for (k=0;k<temp_constraints-j;k++) {
5781               for (ii=0;ii<size_of_constraint;ii++) {
5782                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5783               }
5784             }
5785           }
5786 #else  /* on missing GESVD */
5787           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5788           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5789           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5790           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5791 #if !defined(PETSC_USE_COMPLEX)
5792           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));
5793 #else
5794           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));
5795 #endif
5796           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5797           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5798           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5799           k = temp_constraints;
5800           if (k > size_of_constraint) k = size_of_constraint;
5801           j = 0;
5802           while (j < k && singular_vals[k-j-1] < tol) j++;
5803           valid_constraints = k-j;
5804           total_counts = total_counts-temp_constraints+valid_constraints;
5805 #endif /* on missing GESVD */
5806         }
5807       }
5808       /* update pointers information */
5809       if (valid_constraints) {
5810         constraints_n[total_counts_cc] = valid_constraints;
5811         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5812         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5813         /* set change_of_basis flag */
5814         if (boolforchange) {
5815           PetscBTSet(change_basis,total_counts_cc);
5816         }
5817         total_counts_cc++;
5818       }
5819     }
5820     /* free workspace */
5821     if (!skip_lapack) {
5822       ierr = PetscFree(work);CHKERRQ(ierr);
5823 #if defined(PETSC_USE_COMPLEX)
5824       ierr = PetscFree(rwork);CHKERRQ(ierr);
5825 #endif
5826       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5827 #if defined(PETSC_MISSING_LAPACK_GESVD)
5828       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5829       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5830 #endif
5831     }
5832     for (k=0;k<nnsp_size;k++) {
5833       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5834     }
5835     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5836     /* free index sets of faces, edges and vertices */
5837     for (i=0;i<n_ISForFaces;i++) {
5838       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5839     }
5840     if (n_ISForFaces) {
5841       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5842     }
5843     for (i=0;i<n_ISForEdges;i++) {
5844       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5845     }
5846     if (n_ISForEdges) {
5847       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5848     }
5849     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5850   } else {
5851     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5852 
5853     total_counts = 0;
5854     n_vertices = 0;
5855     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5856       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5857     }
5858     max_constraints = 0;
5859     total_counts_cc = 0;
5860     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5861       total_counts += pcbddc->adaptive_constraints_n[i];
5862       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5863       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5864     }
5865     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5866     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5867     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5868     constraints_data = pcbddc->adaptive_constraints_data;
5869     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5870     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5871     total_counts_cc = 0;
5872     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5873       if (pcbddc->adaptive_constraints_n[i]) {
5874         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5875       }
5876     }
5877 #if 0
5878     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5879     for (i=0;i<total_counts_cc;i++) {
5880       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5881       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5882       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5883         printf(" %d",constraints_idxs[j]);
5884       }
5885       printf("\n");
5886       printf("number of cc: %d\n",constraints_n[i]);
5887     }
5888     for (i=0;i<n_vertices;i++) {
5889       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5890     }
5891     for (i=0;i<sub_schurs->n_subs;i++) {
5892       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
5893     }
5894 #endif
5895 
5896     max_size_of_constraint = 0;
5897     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]);
5898     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5899     /* Change of basis */
5900     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5901     if (pcbddc->use_change_of_basis) {
5902       for (i=0;i<sub_schurs->n_subs;i++) {
5903         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5904           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5905         }
5906       }
5907     }
5908   }
5909   pcbddc->local_primal_size = total_counts;
5910   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5911 
5912   /* map constraints_idxs in boundary numbering */
5913   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5914   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
5915 
5916   /* Create constraint matrix */
5917   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5918   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5919   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5920 
5921   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5922   /* determine if a QR strategy is needed for change of basis */
5923   qr_needed = PETSC_FALSE;
5924   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5925   total_primal_vertices=0;
5926   pcbddc->local_primal_size_cc = 0;
5927   for (i=0;i<total_counts_cc;i++) {
5928     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5929     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5930       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5931       pcbddc->local_primal_size_cc += 1;
5932     } else if (PetscBTLookup(change_basis,i)) {
5933       for (k=0;k<constraints_n[i];k++) {
5934         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5935       }
5936       pcbddc->local_primal_size_cc += constraints_n[i];
5937       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5938         PetscBTSet(qr_needed_idx,i);
5939         qr_needed = PETSC_TRUE;
5940       }
5941     } else {
5942       pcbddc->local_primal_size_cc += 1;
5943     }
5944   }
5945   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5946   pcbddc->n_vertices = total_primal_vertices;
5947   /* permute indices in order to have a sorted set of vertices */
5948   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5949   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);
5950   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5951   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5952 
5953   /* nonzero structure of constraint matrix */
5954   /* and get reference dof for local constraints */
5955   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5956   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5957 
5958   j = total_primal_vertices;
5959   total_counts = total_primal_vertices;
5960   cum = total_primal_vertices;
5961   for (i=n_vertices;i<total_counts_cc;i++) {
5962     if (!PetscBTLookup(change_basis,i)) {
5963       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5964       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5965       cum++;
5966       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5967       for (k=0;k<constraints_n[i];k++) {
5968         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5969         nnz[j+k] = size_of_constraint;
5970       }
5971       j += constraints_n[i];
5972     }
5973   }
5974   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5975   ierr = PetscFree(nnz);CHKERRQ(ierr);
5976 
5977   /* set values in constraint matrix */
5978   for (i=0;i<total_primal_vertices;i++) {
5979     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5980   }
5981   total_counts = total_primal_vertices;
5982   for (i=n_vertices;i<total_counts_cc;i++) {
5983     if (!PetscBTLookup(change_basis,i)) {
5984       PetscInt *cols;
5985 
5986       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5987       cols = constraints_idxs+constraints_idxs_ptr[i];
5988       for (k=0;k<constraints_n[i];k++) {
5989         PetscInt    row = total_counts+k;
5990         PetscScalar *vals;
5991 
5992         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5993         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5994       }
5995       total_counts += constraints_n[i];
5996     }
5997   }
5998   /* assembling */
5999   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6000   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6001 
6002   /*
6003   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6004   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6005   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6006   */
6007   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6008   if (pcbddc->use_change_of_basis) {
6009     /* dual and primal dofs on a single cc */
6010     PetscInt     dual_dofs,primal_dofs;
6011     /* working stuff for GEQRF */
6012     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6013     PetscBLASInt lqr_work;
6014     /* working stuff for UNGQR */
6015     PetscScalar  *gqr_work,lgqr_work_t;
6016     PetscBLASInt lgqr_work;
6017     /* working stuff for TRTRS */
6018     PetscScalar  *trs_rhs;
6019     PetscBLASInt Blas_NRHS;
6020     /* pointers for values insertion into change of basis matrix */
6021     PetscInt     *start_rows,*start_cols;
6022     PetscScalar  *start_vals;
6023     /* working stuff for values insertion */
6024     PetscBT      is_primal;
6025     PetscInt     *aux_primal_numbering_B;
6026     /* matrix sizes */
6027     PetscInt     global_size,local_size;
6028     /* temporary change of basis */
6029     Mat          localChangeOfBasisMatrix;
6030     /* extra space for debugging */
6031     PetscScalar  *dbg_work;
6032 
6033     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6034     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6035     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6036     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6037     /* nonzeros for local mat */
6038     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6039     if (!pcbddc->benign_change || pcbddc->fake_change) {
6040       for (i=0;i<pcis->n;i++) nnz[i]=1;
6041     } else {
6042       const PetscInt *ii;
6043       PetscInt       n;
6044       PetscBool      flg_row;
6045       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6046       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6047       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6048     }
6049     for (i=n_vertices;i<total_counts_cc;i++) {
6050       if (PetscBTLookup(change_basis,i)) {
6051         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6052         if (PetscBTLookup(qr_needed_idx,i)) {
6053           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6054         } else {
6055           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6056           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6057         }
6058       }
6059     }
6060     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6061     ierr = PetscFree(nnz);CHKERRQ(ierr);
6062     /* Set interior change in the matrix */
6063     if (!pcbddc->benign_change || pcbddc->fake_change) {
6064       for (i=0;i<pcis->n;i++) {
6065         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6066       }
6067     } else {
6068       const PetscInt *ii,*jj;
6069       PetscScalar    *aa;
6070       PetscInt       n;
6071       PetscBool      flg_row;
6072       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6073       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6074       for (i=0;i<n;i++) {
6075         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6076       }
6077       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6078       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6079     }
6080 
6081     if (pcbddc->dbg_flag) {
6082       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6083       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6084     }
6085 
6086 
6087     /* Now we loop on the constraints which need a change of basis */
6088     /*
6089        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6090        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6091 
6092        Basic blocks of change of basis matrix T computed by
6093 
6094           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6095 
6096             | 1        0   ...        0         s_1/S |
6097             | 0        1   ...        0         s_2/S |
6098             |              ...                        |
6099             | 0        ...            1     s_{n-1}/S |
6100             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6101 
6102             with S = \sum_{i=1}^n s_i^2
6103             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6104                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6105 
6106           - QR decomposition of constraints otherwise
6107     */
6108     if (qr_needed) {
6109       /* space to store Q */
6110       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6111       /* array to store scaling factors for reflectors */
6112       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6113       /* first we issue queries for optimal work */
6114       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6115       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6116       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6117       lqr_work = -1;
6118       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6119       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6120       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6121       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6122       lgqr_work = -1;
6123       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6124       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6125       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6126       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6127       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6128       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6129       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6130       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6131       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6132       /* array to store rhs and solution of triangular solver */
6133       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6134       /* allocating workspace for check */
6135       if (pcbddc->dbg_flag) {
6136         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6137       }
6138     }
6139     /* array to store whether a node is primal or not */
6140     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6141     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6142     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6143     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6144     for (i=0;i<total_primal_vertices;i++) {
6145       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6146     }
6147     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6148 
6149     /* loop on constraints and see whether or not they need a change of basis and compute it */
6150     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6151       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6152       if (PetscBTLookup(change_basis,total_counts)) {
6153         /* get constraint info */
6154         primal_dofs = constraints_n[total_counts];
6155         dual_dofs = size_of_constraint-primal_dofs;
6156 
6157         if (pcbddc->dbg_flag) {
6158           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);
6159         }
6160 
6161         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6162 
6163           /* copy quadrature constraints for change of basis check */
6164           if (pcbddc->dbg_flag) {
6165             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6166           }
6167           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6168           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6169 
6170           /* compute QR decomposition of constraints */
6171           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6172           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6173           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6174           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6175           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6176           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6177           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6178 
6179           /* explictly compute R^-T */
6180           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6181           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6182           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6183           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6184           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6185           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6186           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6187           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6188           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6189           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6190 
6191           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6192           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6193           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6194           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6195           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6196           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6197           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6198           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6199           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6200 
6201           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6202              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6203              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6204           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6205           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6206           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6207           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6208           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6209           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6210           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6211           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));
6212           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6213           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6214 
6215           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6216           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6217           /* insert cols for primal dofs */
6218           for (j=0;j<primal_dofs;j++) {
6219             start_vals = &qr_basis[j*size_of_constraint];
6220             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6221             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6222           }
6223           /* insert cols for dual dofs */
6224           for (j=0,k=0;j<dual_dofs;k++) {
6225             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6226               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6227               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6228               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6229               j++;
6230             }
6231           }
6232 
6233           /* check change of basis */
6234           if (pcbddc->dbg_flag) {
6235             PetscInt   ii,jj;
6236             PetscBool valid_qr=PETSC_TRUE;
6237             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6238             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6239             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6240             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6241             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6242             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6243             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6244             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));
6245             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6246             for (jj=0;jj<size_of_constraint;jj++) {
6247               for (ii=0;ii<primal_dofs;ii++) {
6248                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6249                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6250               }
6251             }
6252             if (!valid_qr) {
6253               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6254               for (jj=0;jj<size_of_constraint;jj++) {
6255                 for (ii=0;ii<primal_dofs;ii++) {
6256                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6257                     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]));
6258                   }
6259                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6260                     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]));
6261                   }
6262                 }
6263               }
6264             } else {
6265               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6266             }
6267           }
6268         } else { /* simple transformation block */
6269           PetscInt    row,col;
6270           PetscScalar val,norm;
6271 
6272           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6273           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6274           for (j=0;j<size_of_constraint;j++) {
6275             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6276             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6277             if (!PetscBTLookup(is_primal,row_B)) {
6278               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6279               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6280               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6281             } else {
6282               for (k=0;k<size_of_constraint;k++) {
6283                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6284                 if (row != col) {
6285                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6286                 } else {
6287                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6288                 }
6289                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6290               }
6291             }
6292           }
6293           if (pcbddc->dbg_flag) {
6294             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6295           }
6296         }
6297       } else {
6298         if (pcbddc->dbg_flag) {
6299           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6300         }
6301       }
6302     }
6303 
6304     /* free workspace */
6305     if (qr_needed) {
6306       if (pcbddc->dbg_flag) {
6307         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6308       }
6309       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6310       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6311       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6312       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6313       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6314     }
6315     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6316     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6317     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6318 
6319     /* assembling of global change of variable */
6320     if (!pcbddc->fake_change) {
6321       Mat      tmat;
6322       PetscInt bs;
6323 
6324       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6325       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6326       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6327       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6328       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6329       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6330       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6331       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6332       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6333       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6334       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6335       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6336       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6337       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6338       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6339       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6340       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6341       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6342 
6343       /* check */
6344       if (pcbddc->dbg_flag) {
6345         PetscReal error;
6346         Vec       x,x_change;
6347 
6348         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6349         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6350         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6351         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6352         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6353         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6354         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6355         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6356         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6357         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6358         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6359         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6360         if (error > PETSC_SMALL) {
6361           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6362         }
6363         ierr = VecDestroy(&x);CHKERRQ(ierr);
6364         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6365       }
6366       /* adapt sub_schurs computed (if any) */
6367       if (pcbddc->use_deluxe_scaling) {
6368         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6369 
6370         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");CHKERRQ(ierr);
6371         if (sub_schurs && sub_schurs->S_Ej_all) {
6372           Mat                    S_new,tmat;
6373           IS                     is_all_N,is_V_Sall = NULL;
6374 
6375           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6376           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6377           if (pcbddc->deluxe_zerorows) {
6378             ISLocalToGlobalMapping NtoSall;
6379             IS                     is_V;
6380             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6381             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6382             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6383             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6384             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6385           }
6386           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6387           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6388           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6389           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6390           if (pcbddc->deluxe_zerorows) {
6391             const PetscScalar *array;
6392             const PetscInt    *idxs_V,*idxs_all;
6393             PetscInt          i,n_V;
6394 
6395             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6396             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6397             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6398             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6399             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6400             for (i=0;i<n_V;i++) {
6401               PetscScalar val;
6402               PetscInt    idx;
6403 
6404               idx = idxs_V[i];
6405               val = array[idxs_all[idxs_V[i]]];
6406               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6407             }
6408             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6409             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6410             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6411             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6412             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6413           }
6414           sub_schurs->S_Ej_all = S_new;
6415           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6416           if (sub_schurs->sum_S_Ej_all) {
6417             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6418             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6419             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6420             if (pcbddc->deluxe_zerorows) {
6421               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6422             }
6423             sub_schurs->sum_S_Ej_all = S_new;
6424             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6425           }
6426           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6427           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6428         }
6429         /* destroy any change of basis context in sub_schurs */
6430         if (sub_schurs && sub_schurs->change) {
6431           PetscInt i;
6432 
6433           for (i=0;i<sub_schurs->n_subs;i++) {
6434             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6435           }
6436           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6437         }
6438       }
6439       if (pcbddc->switch_static) { /* need to save the local change */
6440         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6441       } else {
6442         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6443       }
6444       /* determine if any process has changed the pressures locally */
6445       pcbddc->change_interior = pcbddc->benign_have_null;
6446     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6447       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6448       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6449       pcbddc->use_qr_single = qr_needed;
6450     }
6451   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6452     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6453       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6454       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6455     } else {
6456       Mat benign_global = NULL;
6457       if (pcbddc->benign_have_null) {
6458         Mat tmat;
6459 
6460         pcbddc->change_interior = PETSC_TRUE;
6461         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6462         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6463         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6464         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6465         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6466         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6467         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6468         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6469         if (pcbddc->benign_change) {
6470           Mat M;
6471 
6472           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6473           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6474           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6475           ierr = MatDestroy(&M);CHKERRQ(ierr);
6476         } else {
6477           Mat         eye;
6478           PetscScalar *array;
6479 
6480           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6481           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6482           for (i=0;i<pcis->n;i++) {
6483             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6484           }
6485           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6486           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6487           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6488           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6489           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6490         }
6491         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6492         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6493       }
6494       if (pcbddc->user_ChangeOfBasisMatrix) {
6495         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6496         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6497       } else if (pcbddc->benign_have_null) {
6498         pcbddc->ChangeOfBasisMatrix = benign_global;
6499       }
6500     }
6501     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6502       IS             is_global;
6503       const PetscInt *gidxs;
6504 
6505       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6506       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6507       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6508       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6509       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6510     }
6511   }
6512   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6513     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6514   }
6515 
6516   if (!pcbddc->fake_change) {
6517     /* add pressure dofs to set of primal nodes for numbering purposes */
6518     for (i=0;i<pcbddc->benign_n;i++) {
6519       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6520       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6521       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6522       pcbddc->local_primal_size_cc++;
6523       pcbddc->local_primal_size++;
6524     }
6525 
6526     /* check if a new primal space has been introduced (also take into account benign trick) */
6527     pcbddc->new_primal_space_local = PETSC_TRUE;
6528     if (olocal_primal_size == pcbddc->local_primal_size) {
6529       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6530       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6531       if (!pcbddc->new_primal_space_local) {
6532         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6533         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6534       }
6535     }
6536     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6537     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6538   }
6539   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6540 
6541   /* flush dbg viewer */
6542   if (pcbddc->dbg_flag) {
6543     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6544   }
6545 
6546   /* free workspace */
6547   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6548   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6549   if (!pcbddc->adaptive_selection) {
6550     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6551     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6552   } else {
6553     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6554                       pcbddc->adaptive_constraints_idxs_ptr,
6555                       pcbddc->adaptive_constraints_data_ptr,
6556                       pcbddc->adaptive_constraints_idxs,
6557                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6558     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6559     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6560   }
6561   PetscFunctionReturn(0);
6562 }
6563 
6564 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6565 {
6566   ISLocalToGlobalMapping map;
6567   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6568   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6569   PetscInt               i,N;
6570   PetscBool              rcsr = PETSC_FALSE;
6571   PetscErrorCode         ierr;
6572 
6573   PetscFunctionBegin;
6574   if (pcbddc->recompute_topography) {
6575     pcbddc->graphanalyzed = PETSC_FALSE;
6576     /* Reset previously computed graph */
6577     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6578     /* Init local Graph struct */
6579     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6580     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6581     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6582 
6583     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6584       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6585     }
6586     /* Check validity of the csr graph passed in by the user */
6587     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\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6588 
6589     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6590     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6591       PetscInt  *xadj,*adjncy;
6592       PetscInt  nvtxs;
6593       PetscBool flg_row=PETSC_FALSE;
6594 
6595       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6596       if (flg_row) {
6597         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6598         pcbddc->computed_rowadj = PETSC_TRUE;
6599       }
6600       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6601       rcsr = PETSC_TRUE;
6602     }
6603     if (pcbddc->dbg_flag) {
6604       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6605     }
6606 
6607     /* Setup of Graph */
6608     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6609     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6610 
6611     /* attach info on disconnected subdomains if present */
6612     if (pcbddc->n_local_subs) {
6613       PetscInt *local_subs;
6614 
6615       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6616       for (i=0;i<pcbddc->n_local_subs;i++) {
6617         const PetscInt *idxs;
6618         PetscInt       nl,j;
6619 
6620         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6621         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6622         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6623         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6624       }
6625       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6626       pcbddc->mat_graph->local_subs = local_subs;
6627     }
6628   }
6629 
6630   if (!pcbddc->graphanalyzed) {
6631     /* Graph's connected components analysis */
6632     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6633     pcbddc->graphanalyzed = PETSC_TRUE;
6634   }
6635   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6636   PetscFunctionReturn(0);
6637 }
6638 
6639 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6640 {
6641   PetscInt       i,j;
6642   PetscScalar    *alphas;
6643   PetscErrorCode ierr;
6644 
6645   PetscFunctionBegin;
6646   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6647   for (i=0;i<n;i++) {
6648     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6649     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6650     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6651     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6652   }
6653   ierr = PetscFree(alphas);CHKERRQ(ierr);
6654   PetscFunctionReturn(0);
6655 }
6656 
6657 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6658 {
6659   Mat            A;
6660   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6661   PetscMPIInt    size,rank,color;
6662   PetscInt       *xadj,*adjncy;
6663   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6664   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6665   PetscInt       void_procs,*procs_candidates = NULL;
6666   PetscInt       xadj_count,*count;
6667   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6668   PetscSubcomm   psubcomm;
6669   MPI_Comm       subcomm;
6670   PetscErrorCode ierr;
6671 
6672   PetscFunctionBegin;
6673   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6674   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6675   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);
6676   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6677   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6678   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6679 
6680   if (have_void) *have_void = PETSC_FALSE;
6681   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6682   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6683   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6684   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6685   im_active = !!n;
6686   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6687   void_procs = size - active_procs;
6688   /* get ranks of of non-active processes in mat communicator */
6689   if (void_procs) {
6690     PetscInt ncand;
6691 
6692     if (have_void) *have_void = PETSC_TRUE;
6693     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6694     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6695     for (i=0,ncand=0;i<size;i++) {
6696       if (!procs_candidates[i]) {
6697         procs_candidates[ncand++] = i;
6698       }
6699     }
6700     /* force n_subdomains to be not greater that the number of non-active processes */
6701     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6702   }
6703 
6704   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6705      number of subdomains requested 1 -> send to master or first candidate in voids  */
6706   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6707   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6708     PetscInt issize,isidx,dest;
6709     if (*n_subdomains == 1) dest = 0;
6710     else dest = rank;
6711     if (im_active) {
6712       issize = 1;
6713       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6714         isidx = procs_candidates[dest];
6715       } else {
6716         isidx = dest;
6717       }
6718     } else {
6719       issize = 0;
6720       isidx = -1;
6721     }
6722     if (*n_subdomains != 1) *n_subdomains = active_procs;
6723     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6724     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6725     PetscFunctionReturn(0);
6726   }
6727   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6728   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6729   threshold = PetscMax(threshold,2);
6730 
6731   /* Get info on mapping */
6732   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6733 
6734   /* build local CSR graph of subdomains' connectivity */
6735   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6736   xadj[0] = 0;
6737   xadj[1] = PetscMax(n_neighs-1,0);
6738   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6739   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6740   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6741   for (i=1;i<n_neighs;i++)
6742     for (j=0;j<n_shared[i];j++)
6743       count[shared[i][j]] += 1;
6744 
6745   xadj_count = 0;
6746   for (i=1;i<n_neighs;i++) {
6747     for (j=0;j<n_shared[i];j++) {
6748       if (count[shared[i][j]] < threshold) {
6749         adjncy[xadj_count] = neighs[i];
6750         adjncy_wgt[xadj_count] = n_shared[i];
6751         xadj_count++;
6752         break;
6753       }
6754     }
6755   }
6756   xadj[1] = xadj_count;
6757   ierr = PetscFree(count);CHKERRQ(ierr);
6758   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6759   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6760 
6761   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6762 
6763   /* Restrict work on active processes only */
6764   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6765   if (void_procs) {
6766     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6767     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6768     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6769     subcomm = PetscSubcommChild(psubcomm);
6770   } else {
6771     psubcomm = NULL;
6772     subcomm = PetscObjectComm((PetscObject)mat);
6773   }
6774 
6775   v_wgt = NULL;
6776   if (!color) {
6777     ierr = PetscFree(xadj);CHKERRQ(ierr);
6778     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6779     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6780   } else {
6781     Mat             subdomain_adj;
6782     IS              new_ranks,new_ranks_contig;
6783     MatPartitioning partitioner;
6784     PetscInt        rstart=0,rend=0;
6785     PetscInt        *is_indices,*oldranks;
6786     PetscMPIInt     size;
6787     PetscBool       aggregate;
6788 
6789     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6790     if (void_procs) {
6791       PetscInt prank = rank;
6792       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6793       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6794       for (i=0;i<xadj[1];i++) {
6795         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6796       }
6797       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6798     } else {
6799       oldranks = NULL;
6800     }
6801     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6802     if (aggregate) { /* TODO: all this part could be made more efficient */
6803       PetscInt    lrows,row,ncols,*cols;
6804       PetscMPIInt nrank;
6805       PetscScalar *vals;
6806 
6807       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6808       lrows = 0;
6809       if (nrank<redprocs) {
6810         lrows = size/redprocs;
6811         if (nrank<size%redprocs) lrows++;
6812       }
6813       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6814       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6815       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6816       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6817       row = nrank;
6818       ncols = xadj[1]-xadj[0];
6819       cols = adjncy;
6820       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6821       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6822       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6823       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6824       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6825       ierr = PetscFree(xadj);CHKERRQ(ierr);
6826       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6827       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6828       ierr = PetscFree(vals);CHKERRQ(ierr);
6829       if (use_vwgt) {
6830         Vec               v;
6831         const PetscScalar *array;
6832         PetscInt          nl;
6833 
6834         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6835         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6836         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6837         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6838         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6839         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6840         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6841         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6842         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6843         ierr = VecDestroy(&v);CHKERRQ(ierr);
6844       }
6845     } else {
6846       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6847       if (use_vwgt) {
6848         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6849         v_wgt[0] = n;
6850       }
6851     }
6852     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6853 
6854     /* Partition */
6855     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6856     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6857     if (v_wgt) {
6858       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6859     }
6860     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6861     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6862     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6863     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6864     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6865 
6866     /* renumber new_ranks to avoid "holes" in new set of processors */
6867     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6868     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6869     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6870     if (!aggregate) {
6871       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6872 #if defined(PETSC_USE_DEBUG)
6873         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6874 #endif
6875         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6876       } else if (oldranks) {
6877         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6878       } else {
6879         ranks_send_to_idx[0] = is_indices[0];
6880       }
6881     } else {
6882       PetscInt    idxs[1];
6883       PetscMPIInt tag;
6884       MPI_Request *reqs;
6885 
6886       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6887       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6888       for (i=rstart;i<rend;i++) {
6889         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6890       }
6891       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6892       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6893       ierr = PetscFree(reqs);CHKERRQ(ierr);
6894       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6895 #if defined(PETSC_USE_DEBUG)
6896         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6897 #endif
6898         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6899       } else if (oldranks) {
6900         ranks_send_to_idx[0] = oldranks[idxs[0]];
6901       } else {
6902         ranks_send_to_idx[0] = idxs[0];
6903       }
6904     }
6905     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6906     /* clean up */
6907     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6908     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6909     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6910     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6911   }
6912   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6913   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6914 
6915   /* assemble parallel IS for sends */
6916   i = 1;
6917   if (!color) i=0;
6918   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6919   PetscFunctionReturn(0);
6920 }
6921 
6922 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6923 
6924 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[])
6925 {
6926   Mat                    local_mat;
6927   IS                     is_sends_internal;
6928   PetscInt               rows,cols,new_local_rows;
6929   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6930   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6931   ISLocalToGlobalMapping l2gmap;
6932   PetscInt*              l2gmap_indices;
6933   const PetscInt*        is_indices;
6934   MatType                new_local_type;
6935   /* buffers */
6936   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6937   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6938   PetscInt               *recv_buffer_idxs_local;
6939   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6940   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6941   /* MPI */
6942   MPI_Comm               comm,comm_n;
6943   PetscSubcomm           subcomm;
6944   PetscMPIInt            n_sends,n_recvs,commsize;
6945   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6946   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6947   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6948   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6949   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6950   PetscErrorCode         ierr;
6951 
6952   PetscFunctionBegin;
6953   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6954   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6955   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);
6956   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6957   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6958   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6959   PetscValidLogicalCollectiveBool(mat,reuse,6);
6960   PetscValidLogicalCollectiveInt(mat,nis,8);
6961   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6962   if (nvecs) {
6963     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6964     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6965   }
6966   /* further checks */
6967   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6968   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6969   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6970   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6971   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6972   if (reuse && *mat_n) {
6973     PetscInt mrows,mcols,mnrows,mncols;
6974     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6975     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6976     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6977     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6978     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6979     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6980     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6981   }
6982   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6983   PetscValidLogicalCollectiveInt(mat,bs,0);
6984 
6985   /* prepare IS for sending if not provided */
6986   if (!is_sends) {
6987     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6988     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6989   } else {
6990     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6991     is_sends_internal = is_sends;
6992   }
6993 
6994   /* get comm */
6995   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6996 
6997   /* compute number of sends */
6998   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6999   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7000 
7001   /* compute number of receives */
7002   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7003   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7004   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7005   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7006   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7007   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7008   ierr = PetscFree(iflags);CHKERRQ(ierr);
7009 
7010   /* restrict comm if requested */
7011   subcomm = 0;
7012   destroy_mat = PETSC_FALSE;
7013   if (restrict_comm) {
7014     PetscMPIInt color,subcommsize;
7015 
7016     color = 0;
7017     if (restrict_full) {
7018       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7019     } else {
7020       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7021     }
7022     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7023     subcommsize = commsize - subcommsize;
7024     /* check if reuse has been requested */
7025     if (reuse) {
7026       if (*mat_n) {
7027         PetscMPIInt subcommsize2;
7028         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7029         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7030         comm_n = PetscObjectComm((PetscObject)*mat_n);
7031       } else {
7032         comm_n = PETSC_COMM_SELF;
7033       }
7034     } else { /* MAT_INITIAL_MATRIX */
7035       PetscMPIInt rank;
7036 
7037       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7038       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7039       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7040       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7041       comm_n = PetscSubcommChild(subcomm);
7042     }
7043     /* flag to destroy *mat_n if not significative */
7044     if (color) destroy_mat = PETSC_TRUE;
7045   } else {
7046     comm_n = comm;
7047   }
7048 
7049   /* prepare send/receive buffers */
7050   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7051   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7052   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7053   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7054   if (nis) {
7055     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7056   }
7057 
7058   /* Get data from local matrices */
7059   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7060     /* TODO: See below some guidelines on how to prepare the local buffers */
7061     /*
7062        send_buffer_vals should contain the raw values of the local matrix
7063        send_buffer_idxs should contain:
7064        - MatType_PRIVATE type
7065        - PetscInt        size_of_l2gmap
7066        - PetscInt        global_row_indices[size_of_l2gmap]
7067        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7068     */
7069   else {
7070     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7071     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7072     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7073     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7074     send_buffer_idxs[1] = i;
7075     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7076     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7077     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7078     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7079     for (i=0;i<n_sends;i++) {
7080       ilengths_vals[is_indices[i]] = len*len;
7081       ilengths_idxs[is_indices[i]] = len+2;
7082     }
7083   }
7084   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7085   /* additional is (if any) */
7086   if (nis) {
7087     PetscMPIInt psum;
7088     PetscInt j;
7089     for (j=0,psum=0;j<nis;j++) {
7090       PetscInt plen;
7091       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7092       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7093       psum += len+1; /* indices + lenght */
7094     }
7095     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7096     for (j=0,psum=0;j<nis;j++) {
7097       PetscInt plen;
7098       const PetscInt *is_array_idxs;
7099       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7100       send_buffer_idxs_is[psum] = plen;
7101       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7102       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7103       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7104       psum += plen+1; /* indices + lenght */
7105     }
7106     for (i=0;i<n_sends;i++) {
7107       ilengths_idxs_is[is_indices[i]] = psum;
7108     }
7109     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7110   }
7111   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7112 
7113   buf_size_idxs = 0;
7114   buf_size_vals = 0;
7115   buf_size_idxs_is = 0;
7116   buf_size_vecs = 0;
7117   for (i=0;i<n_recvs;i++) {
7118     buf_size_idxs += (PetscInt)olengths_idxs[i];
7119     buf_size_vals += (PetscInt)olengths_vals[i];
7120     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7121     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7122   }
7123   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7124   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7125   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7126   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7127 
7128   /* get new tags for clean communications */
7129   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7130   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7131   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7132   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7133 
7134   /* allocate for requests */
7135   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7136   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7137   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7138   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7139   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7140   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7141   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7142   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7143 
7144   /* communications */
7145   ptr_idxs = recv_buffer_idxs;
7146   ptr_vals = recv_buffer_vals;
7147   ptr_idxs_is = recv_buffer_idxs_is;
7148   ptr_vecs = recv_buffer_vecs;
7149   for (i=0;i<n_recvs;i++) {
7150     source_dest = onodes[i];
7151     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7152     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7153     ptr_idxs += olengths_idxs[i];
7154     ptr_vals += olengths_vals[i];
7155     if (nis) {
7156       source_dest = onodes_is[i];
7157       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);
7158       ptr_idxs_is += olengths_idxs_is[i];
7159     }
7160     if (nvecs) {
7161       source_dest = onodes[i];
7162       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7163       ptr_vecs += olengths_idxs[i]-2;
7164     }
7165   }
7166   for (i=0;i<n_sends;i++) {
7167     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7168     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7169     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7170     if (nis) {
7171       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);
7172     }
7173     if (nvecs) {
7174       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7175       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7176     }
7177   }
7178   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7179   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7180 
7181   /* assemble new l2g map */
7182   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7183   ptr_idxs = recv_buffer_idxs;
7184   new_local_rows = 0;
7185   for (i=0;i<n_recvs;i++) {
7186     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7187     ptr_idxs += olengths_idxs[i];
7188   }
7189   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7190   ptr_idxs = recv_buffer_idxs;
7191   new_local_rows = 0;
7192   for (i=0;i<n_recvs;i++) {
7193     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7194     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7195     ptr_idxs += olengths_idxs[i];
7196   }
7197   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7198   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7199   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7200 
7201   /* infer new local matrix type from received local matrices type */
7202   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7203   /* 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) */
7204   if (n_recvs) {
7205     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7206     ptr_idxs = recv_buffer_idxs;
7207     for (i=0;i<n_recvs;i++) {
7208       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7209         new_local_type_private = MATAIJ_PRIVATE;
7210         break;
7211       }
7212       ptr_idxs += olengths_idxs[i];
7213     }
7214     switch (new_local_type_private) {
7215       case MATDENSE_PRIVATE:
7216         new_local_type = MATSEQAIJ;
7217         bs = 1;
7218         break;
7219       case MATAIJ_PRIVATE:
7220         new_local_type = MATSEQAIJ;
7221         bs = 1;
7222         break;
7223       case MATBAIJ_PRIVATE:
7224         new_local_type = MATSEQBAIJ;
7225         break;
7226       case MATSBAIJ_PRIVATE:
7227         new_local_type = MATSEQSBAIJ;
7228         break;
7229       default:
7230         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7231         break;
7232     }
7233   } else { /* by default, new_local_type is seqaij */
7234     new_local_type = MATSEQAIJ;
7235     bs = 1;
7236   }
7237 
7238   /* create MATIS object if needed */
7239   if (!reuse) {
7240     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7241     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7242   } else {
7243     /* it also destroys the local matrices */
7244     if (*mat_n) {
7245       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7246     } else { /* this is a fake object */
7247       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7248     }
7249   }
7250   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7251   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7252 
7253   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7254 
7255   /* Global to local map of received indices */
7256   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7257   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7258   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7259 
7260   /* restore attributes -> type of incoming data and its size */
7261   buf_size_idxs = 0;
7262   for (i=0;i<n_recvs;i++) {
7263     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7264     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7265     buf_size_idxs += (PetscInt)olengths_idxs[i];
7266   }
7267   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7268 
7269   /* set preallocation */
7270   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7271   if (!newisdense) {
7272     PetscInt *new_local_nnz=0;
7273 
7274     ptr_idxs = recv_buffer_idxs_local;
7275     if (n_recvs) {
7276       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7277     }
7278     for (i=0;i<n_recvs;i++) {
7279       PetscInt j;
7280       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7281         for (j=0;j<*(ptr_idxs+1);j++) {
7282           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7283         }
7284       } else {
7285         /* TODO */
7286       }
7287       ptr_idxs += olengths_idxs[i];
7288     }
7289     if (new_local_nnz) {
7290       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7291       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7292       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7293       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7294       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7295       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7296     } else {
7297       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7298     }
7299     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7300   } else {
7301     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7302   }
7303 
7304   /* set values */
7305   ptr_vals = recv_buffer_vals;
7306   ptr_idxs = recv_buffer_idxs_local;
7307   for (i=0;i<n_recvs;i++) {
7308     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7309       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7310       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7311       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7312       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7313       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7314     } else {
7315       /* TODO */
7316     }
7317     ptr_idxs += olengths_idxs[i];
7318     ptr_vals += olengths_vals[i];
7319   }
7320   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7321   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7322   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7323   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7324   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7325   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7326 
7327 #if 0
7328   if (!restrict_comm) { /* check */
7329     Vec       lvec,rvec;
7330     PetscReal infty_error;
7331 
7332     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7333     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7334     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7335     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7336     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7337     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7338     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7339     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7340     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7341   }
7342 #endif
7343 
7344   /* assemble new additional is (if any) */
7345   if (nis) {
7346     PetscInt **temp_idxs,*count_is,j,psum;
7347 
7348     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7349     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7350     ptr_idxs = recv_buffer_idxs_is;
7351     psum = 0;
7352     for (i=0;i<n_recvs;i++) {
7353       for (j=0;j<nis;j++) {
7354         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7355         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7356         psum += plen;
7357         ptr_idxs += plen+1; /* shift pointer to received data */
7358       }
7359     }
7360     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7361     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7362     for (i=1;i<nis;i++) {
7363       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7364     }
7365     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7366     ptr_idxs = recv_buffer_idxs_is;
7367     for (i=0;i<n_recvs;i++) {
7368       for (j=0;j<nis;j++) {
7369         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7370         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7371         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7372         ptr_idxs += plen+1; /* shift pointer to received data */
7373       }
7374     }
7375     for (i=0;i<nis;i++) {
7376       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7377       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7378       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7379     }
7380     ierr = PetscFree(count_is);CHKERRQ(ierr);
7381     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7382     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7383   }
7384   /* free workspace */
7385   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7386   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7387   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7388   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7389   if (isdense) {
7390     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7391     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7392     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7393   } else {
7394     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7395   }
7396   if (nis) {
7397     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7398     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7399   }
7400 
7401   if (nvecs) {
7402     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7403     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7404     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7405     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7406     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7407     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7408     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7409     /* set values */
7410     ptr_vals = recv_buffer_vecs;
7411     ptr_idxs = recv_buffer_idxs_local;
7412     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7413     for (i=0;i<n_recvs;i++) {
7414       PetscInt j;
7415       for (j=0;j<*(ptr_idxs+1);j++) {
7416         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7417       }
7418       ptr_idxs += olengths_idxs[i];
7419       ptr_vals += olengths_idxs[i]-2;
7420     }
7421     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7422     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7423     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7424   }
7425 
7426   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7427   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7428   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7429   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7430   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7431   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7432   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7433   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7434   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7435   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7436   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7437   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7438   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7439   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7440   ierr = PetscFree(onodes);CHKERRQ(ierr);
7441   if (nis) {
7442     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7443     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7444     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7445   }
7446   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7447   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7448     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7449     for (i=0;i<nis;i++) {
7450       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7451     }
7452     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7453       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7454     }
7455     *mat_n = NULL;
7456   }
7457   PetscFunctionReturn(0);
7458 }
7459 
7460 /* temporary hack into ksp private data structure */
7461 #include <petsc/private/kspimpl.h>
7462 
7463 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7464 {
7465   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7466   PC_IS                  *pcis = (PC_IS*)pc->data;
7467   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7468   Mat                    coarsedivudotp = NULL;
7469   Mat                    coarseG,t_coarse_mat_is;
7470   MatNullSpace           CoarseNullSpace = NULL;
7471   ISLocalToGlobalMapping coarse_islg;
7472   IS                     coarse_is,*isarray;
7473   PetscInt               i,im_active=-1,active_procs=-1;
7474   PetscInt               nis,nisdofs,nisneu,nisvert;
7475   PC                     pc_temp;
7476   PCType                 coarse_pc_type;
7477   KSPType                coarse_ksp_type;
7478   PetscBool              multilevel_requested,multilevel_allowed;
7479   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7480   PetscInt               ncoarse,nedcfield;
7481   PetscBool              compute_vecs = PETSC_FALSE;
7482   PetscScalar            *array;
7483   MatReuse               coarse_mat_reuse;
7484   PetscBool              restr, full_restr, have_void;
7485   PetscMPIInt            commsize;
7486   PetscErrorCode         ierr;
7487 
7488   PetscFunctionBegin;
7489   /* Assign global numbering to coarse dofs */
7490   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 */
7491     PetscInt ocoarse_size;
7492     compute_vecs = PETSC_TRUE;
7493 
7494     pcbddc->new_primal_space = PETSC_TRUE;
7495     ocoarse_size = pcbddc->coarse_size;
7496     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7497     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7498     /* see if we can avoid some work */
7499     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7500       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7501       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7502         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7503         coarse_reuse = PETSC_FALSE;
7504       } else { /* we can safely reuse already computed coarse matrix */
7505         coarse_reuse = PETSC_TRUE;
7506       }
7507     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7508       coarse_reuse = PETSC_FALSE;
7509     }
7510     /* reset any subassembling information */
7511     if (!coarse_reuse || pcbddc->recompute_topography) {
7512       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7513     }
7514   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7515     coarse_reuse = PETSC_TRUE;
7516   }
7517   /* assemble coarse matrix */
7518   if (coarse_reuse && pcbddc->coarse_ksp) {
7519     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7520     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7521     coarse_mat_reuse = MAT_REUSE_MATRIX;
7522   } else {
7523     coarse_mat = NULL;
7524     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7525   }
7526 
7527   /* creates temporary l2gmap and IS for coarse indexes */
7528   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7529   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7530 
7531   /* creates temporary MATIS object for coarse matrix */
7532   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7533   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7534   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7535   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7536   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);
7537   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7538   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7539   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7540   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7541 
7542   /* count "active" (i.e. with positive local size) and "void" processes */
7543   im_active = !!(pcis->n);
7544   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7545 
7546   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7547   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7548   /* full_restr : just use the receivers from the subassembling pattern */
7549   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7550   coarse_mat_is = NULL;
7551   multilevel_allowed = PETSC_FALSE;
7552   multilevel_requested = PETSC_FALSE;
7553   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7554   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7555   if (multilevel_requested) {
7556     ncoarse = active_procs/pcbddc->coarsening_ratio;
7557     restr = PETSC_FALSE;
7558     full_restr = PETSC_FALSE;
7559   } else {
7560     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7561     restr = PETSC_TRUE;
7562     full_restr = PETSC_TRUE;
7563   }
7564   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7565   ncoarse = PetscMax(1,ncoarse);
7566   if (!pcbddc->coarse_subassembling) {
7567     if (pcbddc->coarsening_ratio > 1) {
7568       if (multilevel_requested) {
7569         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7570       } else {
7571         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7572       }
7573     } else {
7574       PetscMPIInt rank;
7575       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7576       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7577       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7578     }
7579   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7580     PetscInt    psum;
7581     if (pcbddc->coarse_ksp) psum = 1;
7582     else psum = 0;
7583     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7584     if (ncoarse < commsize) have_void = PETSC_TRUE;
7585   }
7586   /* determine if we can go multilevel */
7587   if (multilevel_requested) {
7588     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7589     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7590   }
7591   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7592 
7593   /* dump subassembling pattern */
7594   if (pcbddc->dbg_flag && multilevel_allowed) {
7595     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7596   }
7597 
7598   /* compute dofs splitting and neumann boundaries for coarse dofs */
7599   nedcfield = -1;
7600   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7601     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7602     const PetscInt         *idxs;
7603     ISLocalToGlobalMapping tmap;
7604 
7605     /* create map between primal indices (in local representative ordering) and local primal numbering */
7606     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7607     /* allocate space for temporary storage */
7608     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7609     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7610     /* allocate for IS array */
7611     nisdofs = pcbddc->n_ISForDofsLocal;
7612     if (pcbddc->nedclocal) {
7613       if (pcbddc->nedfield > -1) {
7614         nedcfield = pcbddc->nedfield;
7615       } else {
7616         nedcfield = 0;
7617         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7618         nisdofs = 1;
7619       }
7620     }
7621     nisneu = !!pcbddc->NeumannBoundariesLocal;
7622     nisvert = 0; /* nisvert is not used */
7623     nis = nisdofs + nisneu + nisvert;
7624     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7625     /* dofs splitting */
7626     for (i=0;i<nisdofs;i++) {
7627       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7628       if (nedcfield != i) {
7629         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7630         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7631         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7632         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7633       } else {
7634         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7635         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7636         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7637         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7638         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7639       }
7640       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7641       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7642       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7643     }
7644     /* neumann boundaries */
7645     if (pcbddc->NeumannBoundariesLocal) {
7646       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7647       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7648       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7649       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7650       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7651       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7652       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7653       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7654     }
7655     /* free memory */
7656     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7657     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7658     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7659   } else {
7660     nis = 0;
7661     nisdofs = 0;
7662     nisneu = 0;
7663     nisvert = 0;
7664     isarray = NULL;
7665   }
7666   /* destroy no longer needed map */
7667   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7668 
7669   /* subassemble */
7670   if (multilevel_allowed) {
7671     Vec       vp[1];
7672     PetscInt  nvecs = 0;
7673     PetscBool reuse,reuser;
7674 
7675     if (coarse_mat) reuse = PETSC_TRUE;
7676     else reuse = PETSC_FALSE;
7677     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7678     vp[0] = NULL;
7679     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7680       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7681       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7682       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7683       nvecs = 1;
7684 
7685       if (pcbddc->divudotp) {
7686         Mat      B,loc_divudotp;
7687         Vec      v,p;
7688         IS       dummy;
7689         PetscInt np;
7690 
7691         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7692         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7693         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7694         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7695         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7696         ierr = VecSet(p,1.);CHKERRQ(ierr);
7697         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7698         ierr = VecDestroy(&p);CHKERRQ(ierr);
7699         ierr = MatDestroy(&B);CHKERRQ(ierr);
7700         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7701         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7702         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7703         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7704         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7705         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7706         ierr = VecDestroy(&v);CHKERRQ(ierr);
7707       }
7708     }
7709     if (reuser) {
7710       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7711     } else {
7712       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7713     }
7714     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7715       PetscScalar *arraym,*arrayv;
7716       PetscInt    nl;
7717       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7718       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7719       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7720       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7721       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7722       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7723       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7724       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7725     } else {
7726       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7727     }
7728   } else {
7729     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7730   }
7731   if (coarse_mat_is || coarse_mat) {
7732     PetscMPIInt size;
7733     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7734     if (!multilevel_allowed) {
7735       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7736     } else {
7737       Mat A;
7738 
7739       /* if this matrix is present, it means we are not reusing the coarse matrix */
7740       if (coarse_mat_is) {
7741         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7742         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7743         coarse_mat = coarse_mat_is;
7744       }
7745       /* be sure we don't have MatSeqDENSE as local mat */
7746       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7747       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7748     }
7749   }
7750   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7751   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7752 
7753   /* create local to global scatters for coarse problem */
7754   if (compute_vecs) {
7755     PetscInt lrows;
7756     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7757     if (coarse_mat) {
7758       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7759     } else {
7760       lrows = 0;
7761     }
7762     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7763     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7764     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7765     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7766     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7767   }
7768   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7769 
7770   /* set defaults for coarse KSP and PC */
7771   if (multilevel_allowed) {
7772     coarse_ksp_type = KSPRICHARDSON;
7773     coarse_pc_type = PCBDDC;
7774   } else {
7775     coarse_ksp_type = KSPPREONLY;
7776     coarse_pc_type = PCREDUNDANT;
7777   }
7778 
7779   /* print some info if requested */
7780   if (pcbddc->dbg_flag) {
7781     if (!multilevel_allowed) {
7782       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7783       if (multilevel_requested) {
7784         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);
7785       } else if (pcbddc->max_levels) {
7786         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7787       }
7788       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7789     }
7790   }
7791 
7792   /* communicate coarse discrete gradient */
7793   coarseG = NULL;
7794   if (pcbddc->nedcG && multilevel_allowed) {
7795     MPI_Comm ccomm;
7796     if (coarse_mat) {
7797       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7798     } else {
7799       ccomm = MPI_COMM_NULL;
7800     }
7801     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7802   }
7803 
7804   /* create the coarse KSP object only once with defaults */
7805   if (coarse_mat) {
7806     PetscViewer dbg_viewer = NULL;
7807     if (pcbddc->dbg_flag) {
7808       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7809       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7810     }
7811     if (!pcbddc->coarse_ksp) {
7812       char prefix[256],str_level[16];
7813       size_t len;
7814 
7815       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7816       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7817       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7818       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7819       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7820       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7821       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7822       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7823       /* TODO is this logic correct? should check for coarse_mat type */
7824       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7825       /* prefix */
7826       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7827       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7828       if (!pcbddc->current_level) {
7829         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7830         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7831       } else {
7832         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7833         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7834         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7835         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7836         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7837         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7838       }
7839       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7840       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7841       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7842       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7843       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7844       /* allow user customization */
7845       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7846     }
7847     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7848     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7849     if (nisdofs) {
7850       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7851       for (i=0;i<nisdofs;i++) {
7852         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7853       }
7854     }
7855     if (nisneu) {
7856       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7857       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7858     }
7859     if (nisvert) {
7860       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7861       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7862     }
7863     if (coarseG) {
7864       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7865     }
7866 
7867     /* get some info after set from options */
7868     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7869     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7870     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7871     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7872     if (isbddc && !multilevel_allowed) {
7873       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7874       isbddc = PETSC_FALSE;
7875     }
7876     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7877     if (multilevel_requested && !isbddc && !isnn) {
7878       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7879       isbddc = PETSC_TRUE;
7880       isnn   = PETSC_FALSE;
7881     }
7882     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7883     if (isredundant) {
7884       KSP inner_ksp;
7885       PC  inner_pc;
7886 
7887       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7888       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7889       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7890     }
7891 
7892     /* parameters which miss an API */
7893     if (isbddc) {
7894       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7895       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7896       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7897       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7898       if (pcbddc_coarse->benign_saddle_point) {
7899         Mat                    coarsedivudotp_is;
7900         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7901         IS                     row,col;
7902         const PetscInt         *gidxs;
7903         PetscInt               n,st,M,N;
7904 
7905         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7906         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7907         st   = st-n;
7908         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7909         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7910         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7911         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7912         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7913         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7914         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7915         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7916         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7917         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7918         ierr = ISDestroy(&row);CHKERRQ(ierr);
7919         ierr = ISDestroy(&col);CHKERRQ(ierr);
7920         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7921         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7922         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7923         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7924         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7925         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7926         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7927         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7928         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7929         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7930         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7931         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7932       }
7933     }
7934 
7935     /* propagate symmetry info of coarse matrix */
7936     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7937     if (pc->pmat->symmetric_set) {
7938       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7939     }
7940     if (pc->pmat->hermitian_set) {
7941       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7942     }
7943     if (pc->pmat->spd_set) {
7944       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7945     }
7946     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7947       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7948     }
7949     /* set operators */
7950     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7951     if (pcbddc->dbg_flag) {
7952       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7953     }
7954   }
7955   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7956   ierr = PetscFree(isarray);CHKERRQ(ierr);
7957 #if 0
7958   {
7959     PetscViewer viewer;
7960     char filename[256];
7961     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7962     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7963     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7964     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7965     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7966     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7967   }
7968 #endif
7969 
7970   if (pcbddc->coarse_ksp) {
7971     Vec crhs,csol;
7972 
7973     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7974     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7975     if (!csol) {
7976       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7977     }
7978     if (!crhs) {
7979       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7980     }
7981   }
7982   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7983 
7984   /* compute null space for coarse solver if the benign trick has been requested */
7985   if (pcbddc->benign_null) {
7986 
7987     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7988     for (i=0;i<pcbddc->benign_n;i++) {
7989       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7990     }
7991     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7992     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7993     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7994     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7995     if (coarse_mat) {
7996       Vec         nullv;
7997       PetscScalar *array,*array2;
7998       PetscInt    nl;
7999 
8000       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8001       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8002       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8003       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8004       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8005       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8006       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8007       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8008       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8009       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8010     }
8011   }
8012 
8013   if (pcbddc->coarse_ksp) {
8014     PetscBool ispreonly;
8015 
8016     if (CoarseNullSpace) {
8017       PetscBool isnull;
8018       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8019       if (isnull) {
8020         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8021       }
8022       /* TODO: add local nullspaces (if any) */
8023     }
8024     /* setup coarse ksp */
8025     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8026     /* Check coarse problem if in debug mode or if solving with an iterative method */
8027     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8028     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8029       KSP       check_ksp;
8030       KSPType   check_ksp_type;
8031       PC        check_pc;
8032       Vec       check_vec,coarse_vec;
8033       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8034       PetscInt  its;
8035       PetscBool compute_eigs;
8036       PetscReal *eigs_r,*eigs_c;
8037       PetscInt  neigs;
8038       const char *prefix;
8039 
8040       /* Create ksp object suitable for estimation of extreme eigenvalues */
8041       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8042       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8043       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8044       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8045       /* prevent from setup unneeded object */
8046       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8047       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8048       if (ispreonly) {
8049         check_ksp_type = KSPPREONLY;
8050         compute_eigs = PETSC_FALSE;
8051       } else {
8052         check_ksp_type = KSPGMRES;
8053         compute_eigs = PETSC_TRUE;
8054       }
8055       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8056       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8057       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8058       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8059       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8060       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8061       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8062       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8063       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8064       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8065       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8066       /* create random vec */
8067       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8068       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8069       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8070       /* solve coarse problem */
8071       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8072       /* set eigenvalue estimation if preonly has not been requested */
8073       if (compute_eigs) {
8074         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8075         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8076         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8077         if (neigs) {
8078           lambda_max = eigs_r[neigs-1];
8079           lambda_min = eigs_r[0];
8080           if (pcbddc->use_coarse_estimates) {
8081             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8082               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8083               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8084             }
8085           }
8086         }
8087       }
8088 
8089       /* check coarse problem residual error */
8090       if (pcbddc->dbg_flag) {
8091         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8092         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8093         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8094         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8095         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8096         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8097         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8098         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8099         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8100         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8101         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8102         if (CoarseNullSpace) {
8103           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8104         }
8105         if (compute_eigs) {
8106           PetscReal          lambda_max_s,lambda_min_s;
8107           KSPConvergedReason reason;
8108           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8109           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8110           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8111           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8112           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);
8113           for (i=0;i<neigs;i++) {
8114             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8115           }
8116         }
8117         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8118         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8119       }
8120       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8121       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8122       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8123       if (compute_eigs) {
8124         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8125         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8126       }
8127     }
8128   }
8129   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8130   /* print additional info */
8131   if (pcbddc->dbg_flag) {
8132     /* waits until all processes reaches this point */
8133     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8134     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8135     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8136   }
8137 
8138   /* free memory */
8139   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8140   PetscFunctionReturn(0);
8141 }
8142 
8143 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8144 {
8145   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8146   PC_IS*         pcis = (PC_IS*)pc->data;
8147   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8148   IS             subset,subset_mult,subset_n;
8149   PetscInt       local_size,coarse_size=0;
8150   PetscInt       *local_primal_indices=NULL;
8151   const PetscInt *t_local_primal_indices;
8152   PetscErrorCode ierr;
8153 
8154   PetscFunctionBegin;
8155   /* Compute global number of coarse dofs */
8156   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8157   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8158   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8159   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8160   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8161   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8162   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8163   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8164   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8165   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);
8166   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8167   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8168   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8169   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8170   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8171 
8172   /* check numbering */
8173   if (pcbddc->dbg_flag) {
8174     PetscScalar coarsesum,*array,*array2;
8175     PetscInt    i;
8176     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8177 
8178     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8179     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8180     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8181     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8182     /* counter */
8183     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8184     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8185     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8186     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8187     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8188     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8189     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8190     for (i=0;i<pcbddc->local_primal_size;i++) {
8191       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8192     }
8193     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8194     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8195     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8196     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8197     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8198     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8199     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8200     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8201     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8202     for (i=0;i<pcis->n;i++) {
8203       if (array[i] != 0.0 && array[i] != array2[i]) {
8204         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8205         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8206         set_error = PETSC_TRUE;
8207         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8208         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);
8209       }
8210     }
8211     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8212     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8213     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8214     for (i=0;i<pcis->n;i++) {
8215       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8216     }
8217     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8218     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8219     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8220     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8221     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8222     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8223     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8224       PetscInt *gidxs;
8225 
8226       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8227       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8228       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8229       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8230       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8231       for (i=0;i<pcbddc->local_primal_size;i++) {
8232         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);
8233       }
8234       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8235       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8236     }
8237     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8238     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8239     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8240   }
8241   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8242   /* get back data */
8243   *coarse_size_n = coarse_size;
8244   *local_primal_indices_n = local_primal_indices;
8245   PetscFunctionReturn(0);
8246 }
8247 
8248 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8249 {
8250   IS             localis_t;
8251   PetscInt       i,lsize,*idxs,n;
8252   PetscScalar    *vals;
8253   PetscErrorCode ierr;
8254 
8255   PetscFunctionBegin;
8256   /* get indices in local ordering exploiting local to global map */
8257   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8258   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8259   for (i=0;i<lsize;i++) vals[i] = 1.0;
8260   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8261   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8262   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8263   if (idxs) { /* multilevel guard */
8264     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8265   }
8266   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8267   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8268   ierr = PetscFree(vals);CHKERRQ(ierr);
8269   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8270   /* now compute set in local ordering */
8271   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8272   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8273   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8274   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8275   for (i=0,lsize=0;i<n;i++) {
8276     if (PetscRealPart(vals[i]) > 0.5) {
8277       lsize++;
8278     }
8279   }
8280   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8281   for (i=0,lsize=0;i<n;i++) {
8282     if (PetscRealPart(vals[i]) > 0.5) {
8283       idxs[lsize++] = i;
8284     }
8285   }
8286   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8287   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8288   *localis = localis_t;
8289   PetscFunctionReturn(0);
8290 }
8291 
8292 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8293 {
8294   PC_IS               *pcis=(PC_IS*)pc->data;
8295   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8296   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8297   Mat                 S_j;
8298   PetscInt            *used_xadj,*used_adjncy;
8299   PetscBool           free_used_adj;
8300   PetscErrorCode      ierr;
8301 
8302   PetscFunctionBegin;
8303   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8304   free_used_adj = PETSC_FALSE;
8305   if (pcbddc->sub_schurs_layers == -1) {
8306     used_xadj = NULL;
8307     used_adjncy = NULL;
8308   } else {
8309     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8310       used_xadj = pcbddc->mat_graph->xadj;
8311       used_adjncy = pcbddc->mat_graph->adjncy;
8312     } else if (pcbddc->computed_rowadj) {
8313       used_xadj = pcbddc->mat_graph->xadj;
8314       used_adjncy = pcbddc->mat_graph->adjncy;
8315     } else {
8316       PetscBool      flg_row=PETSC_FALSE;
8317       const PetscInt *xadj,*adjncy;
8318       PetscInt       nvtxs;
8319 
8320       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8321       if (flg_row) {
8322         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8323         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8324         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8325         free_used_adj = PETSC_TRUE;
8326       } else {
8327         pcbddc->sub_schurs_layers = -1;
8328         used_xadj = NULL;
8329         used_adjncy = NULL;
8330       }
8331       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8332     }
8333   }
8334 
8335   /* setup sub_schurs data */
8336   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8337   if (!sub_schurs->schur_explicit) {
8338     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8339     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8340     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);
8341   } else {
8342     Mat       change = NULL;
8343     Vec       scaling = NULL;
8344     IS        change_primal = NULL, iP;
8345     PetscInt  benign_n;
8346     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8347     PetscBool isseqaij,need_change = PETSC_FALSE;
8348     PetscBool discrete_harmonic = PETSC_FALSE;
8349 
8350     if (!pcbddc->use_vertices && reuse_solvers) {
8351       PetscInt n_vertices;
8352 
8353       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8354       reuse_solvers = (PetscBool)!n_vertices;
8355     }
8356     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8357     if (!isseqaij) {
8358       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8359       if (matis->A == pcbddc->local_mat) {
8360         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8361         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8362       } else {
8363         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8364       }
8365     }
8366     if (!pcbddc->benign_change_explicit) {
8367       benign_n = pcbddc->benign_n;
8368     } else {
8369       benign_n = 0;
8370     }
8371     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8372        We need a global reduction to avoid possible deadlocks.
8373        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8374     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8375       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8376       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8377       need_change = (PetscBool)(!need_change);
8378     }
8379     /* If the user defines additional constraints, we import them here.
8380        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 */
8381     if (need_change) {
8382       PC_IS   *pcisf;
8383       PC_BDDC *pcbddcf;
8384       PC      pcf;
8385 
8386       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8387       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8388       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8389       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8390 
8391       /* hacks */
8392       pcisf                        = (PC_IS*)pcf->data;
8393       pcisf->is_B_local            = pcis->is_B_local;
8394       pcisf->vec1_N                = pcis->vec1_N;
8395       pcisf->BtoNmap               = pcis->BtoNmap;
8396       pcisf->n                     = pcis->n;
8397       pcisf->n_B                   = pcis->n_B;
8398       pcbddcf                      = (PC_BDDC*)pcf->data;
8399       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8400       pcbddcf->mat_graph           = pcbddc->mat_graph;
8401       pcbddcf->use_faces           = PETSC_TRUE;
8402       pcbddcf->use_change_of_basis = PETSC_TRUE;
8403       pcbddcf->use_change_on_faces = PETSC_TRUE;
8404       pcbddcf->use_qr_single       = PETSC_TRUE;
8405       pcbddcf->fake_change         = PETSC_TRUE;
8406 
8407       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8408       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8409       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8410       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8411       change = pcbddcf->ConstraintMatrix;
8412       pcbddcf->ConstraintMatrix = NULL;
8413 
8414       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8415       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8416       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8417       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8418       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8419       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8420       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8421       pcf->ops->destroy = NULL;
8422       pcf->ops->reset   = NULL;
8423       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8424     }
8425     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8426 
8427     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8428     if (iP) {
8429       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8430       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8431       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8432     }
8433     if (discrete_harmonic) {
8434       Mat A;
8435       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8436       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8437       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8438       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);
8439       ierr = MatDestroy(&A);CHKERRQ(ierr);
8440     } else {
8441       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);
8442     }
8443     ierr = MatDestroy(&change);CHKERRQ(ierr);
8444     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8445   }
8446   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8447 
8448   /* free adjacency */
8449   if (free_used_adj) {
8450     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8451   }
8452   PetscFunctionReturn(0);
8453 }
8454 
8455 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8456 {
8457   PC_IS               *pcis=(PC_IS*)pc->data;
8458   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8459   PCBDDCGraph         graph;
8460   PetscErrorCode      ierr;
8461 
8462   PetscFunctionBegin;
8463   /* attach interface graph for determining subsets */
8464   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8465     IS       verticesIS,verticescomm;
8466     PetscInt vsize,*idxs;
8467 
8468     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8469     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8470     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8471     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8472     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8473     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8474     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8475     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8476     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8477     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8478     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8479   } else {
8480     graph = pcbddc->mat_graph;
8481   }
8482   /* print some info */
8483   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8484     IS       vertices;
8485     PetscInt nv,nedges,nfaces;
8486     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8487     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8488     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8489     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8490     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8491     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8492     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8493     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8494     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8495     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8496     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8497   }
8498 
8499   /* sub_schurs init */
8500   if (!pcbddc->sub_schurs) {
8501     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8502   }
8503   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8504   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8505 
8506   /* free graph struct */
8507   if (pcbddc->sub_schurs_rebuild) {
8508     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8509   }
8510   PetscFunctionReturn(0);
8511 }
8512 
8513 PetscErrorCode PCBDDCCheckOperator(PC pc)
8514 {
8515   PC_IS               *pcis=(PC_IS*)pc->data;
8516   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8517   PetscErrorCode      ierr;
8518 
8519   PetscFunctionBegin;
8520   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8521     IS             zerodiag = NULL;
8522     Mat            S_j,B0_B=NULL;
8523     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8524     PetscScalar    *p0_check,*array,*array2;
8525     PetscReal      norm;
8526     PetscInt       i;
8527 
8528     /* B0 and B0_B */
8529     if (zerodiag) {
8530       IS       dummy;
8531 
8532       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8533       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8534       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8535       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8536     }
8537     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8538     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8539     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8540     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8541     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8542     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8543     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8544     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8545     /* S_j */
8546     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8547     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8548 
8549     /* mimic vector in \widetilde{W}_\Gamma */
8550     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8551     /* continuous in primal space */
8552     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8553     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8554     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8555     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8556     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8557     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8558     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8559     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8560     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8561     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8562     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8563     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8564     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8565     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8566 
8567     /* assemble rhs for coarse problem */
8568     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8569     /* local with Schur */
8570     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8571     if (zerodiag) {
8572       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8573       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8574       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8575       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8576     }
8577     /* sum on primal nodes the local contributions */
8578     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8579     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8580     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8581     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8582     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8583     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8584     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8585     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8586     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8587     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8588     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8589     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8590     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8591     /* scale primal nodes (BDDC sums contibutions) */
8592     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8593     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8594     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8595     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8596     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8597     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8598     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8599     /* global: \widetilde{B0}_B w_\Gamma */
8600     if (zerodiag) {
8601       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8602       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8603       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8604       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8605     }
8606     /* BDDC */
8607     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8608     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8609 
8610     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8611     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8612     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8613     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8614     for (i=0;i<pcbddc->benign_n;i++) {
8615       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8616     }
8617     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8618     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8619     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8620     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8621     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8622     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8623   }
8624   PetscFunctionReturn(0);
8625 }
8626 
8627 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8628 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8629 {
8630   Mat            At;
8631   IS             rows;
8632   PetscInt       rst,ren;
8633   PetscErrorCode ierr;
8634   PetscLayout    rmap;
8635 
8636   PetscFunctionBegin;
8637   rst = ren = 0;
8638   if (ccomm != MPI_COMM_NULL) {
8639     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8640     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8641     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8642     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8643     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8644   }
8645   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8646   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8647   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8648 
8649   if (ccomm != MPI_COMM_NULL) {
8650     Mat_MPIAIJ *a,*b;
8651     IS         from,to;
8652     Vec        gvec;
8653     PetscInt   lsize;
8654 
8655     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8656     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8657     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8658     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8659     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8660     a    = (Mat_MPIAIJ*)At->data;
8661     b    = (Mat_MPIAIJ*)(*B)->data;
8662     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8663     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8664     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8665     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8666     b->A = a->A;
8667     b->B = a->B;
8668 
8669     b->donotstash      = a->donotstash;
8670     b->roworiented     = a->roworiented;
8671     b->rowindices      = 0;
8672     b->rowvalues       = 0;
8673     b->getrowactive    = PETSC_FALSE;
8674 
8675     (*B)->rmap         = rmap;
8676     (*B)->factortype   = A->factortype;
8677     (*B)->assembled    = PETSC_TRUE;
8678     (*B)->insertmode   = NOT_SET_VALUES;
8679     (*B)->preallocated = PETSC_TRUE;
8680 
8681     if (a->colmap) {
8682 #if defined(PETSC_USE_CTABLE)
8683       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8684 #else
8685       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8686       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8687       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8688 #endif
8689     } else b->colmap = 0;
8690     if (a->garray) {
8691       PetscInt len;
8692       len  = a->B->cmap->n;
8693       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8694       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8695       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8696     } else b->garray = 0;
8697 
8698     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8699     b->lvec = a->lvec;
8700     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8701 
8702     /* cannot use VecScatterCopy */
8703     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8704     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8705     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8706     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8707     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8708     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8709     ierr = ISDestroy(&from);CHKERRQ(ierr);
8710     ierr = ISDestroy(&to);CHKERRQ(ierr);
8711     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8712   }
8713   ierr = MatDestroy(&At);CHKERRQ(ierr);
8714   PetscFunctionReturn(0);
8715 }
8716