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