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