xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 28b8efb179d0a3058fa134e7f59c338303034f9f)
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 <petscblaslapack.h>
5 #include <petsc/private/sfimpl.h>
6 
7 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
8 
9 /* if range is true,  it returns B s.t. span{B} = range(A)
10    if range is false, it returns B s.t. range(B) _|_ range(A) */
11 #undef __FUNCT__
12 #define __FUNCT__ "MatDenseOrthogonalRangeOrComplement"
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 #undef __FUNCT__
89 #define __FUNCT__ "PCBDDCComputeNedelecChangeEdge"
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatGetSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatGetSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatGetSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 #undef __FUNCT__
156 #define __FUNCT__ "PCBDDCNedelecSupport"
157 PetscErrorCode PCBDDCNedelecSupport(PC pc)
158 {
159   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
160   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
161   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
162   Vec                    tvec;
163   PetscSF                sfv;
164   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
165   MPI_Comm               comm;
166   IS                     lned,primals,allprimals,nedfieldlocal;
167   IS                     *eedges,*extrows,*extcols,*alleedges;
168   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
169   PetscScalar            *vals,*work;
170   PetscReal              *rwork;
171   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
172   PetscInt               ne,nv,Lv,order,n,field;
173   PetscInt               n_neigh,*neigh,*n_shared,**shared;
174   PetscInt               i,j,extmem,cum,maxsize,nee;
175   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
176   PetscInt               *sfvleaves,*sfvroots;
177   PetscInt               *corners,*cedges;
178   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
179 #if defined(PETSC_USE_DEBUG)
180   PetscInt               *emarks;
181 #endif
182   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
183   PetscErrorCode         ierr;
184 
185   PetscFunctionBegin;
186   /* If the discrete gradient is defined for a subset of dofs and global is true,
187      it assumes G is given in global ordering for all the dofs.
188      Otherwise, the ordering is global for the Nedelec field */
189   order      = pcbddc->nedorder;
190   conforming = pcbddc->conforming;
191   field      = pcbddc->nedfield;
192   global     = pcbddc->nedglobal;
193   setprimal  = PETSC_FALSE;
194   print      = PETSC_FALSE;
195   singular   = PETSC_FALSE;
196 
197   /* Command line customization */
198   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
201   ierr = PetscOptionsInt ("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
202   /* print debug info TODO: to be removed */
203   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
204   ierr = PetscOptionsEnd();CHKERRQ(ierr);
205 
206   /* Return if there are no edges in the decomposition and the problem is not singular */
207   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
208   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
209   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
210   if (!singular) {
211     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
212     lrc[0] = PETSC_FALSE;
213     for (i=0;i<n;i++) {
214       if (PetscRealPart(vals[i]) > 2.) {
215         lrc[0] = PETSC_TRUE;
216         break;
217       }
218     }
219     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
220     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
221     if (!lrc[1]) PetscFunctionReturn(0);
222   }
223 
224   /* Get Nedelec field */
225   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
226   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);
227   if (pcbddc->n_ISForDofsLocal && field >= 0) {
228     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
229     nedfieldlocal = pcbddc->ISForDofsLocal[field];
230     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
231   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
232     ne            = n;
233     nedfieldlocal = NULL;
234     global        = PETSC_TRUE;
235   } else if (field == PETSC_DECIDE) {
236     PetscInt rst,ren,*idx;
237 
238     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
239     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
240     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
241     for (i=rst;i<ren;i++) {
242       PetscInt nc;
243 
244       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
246       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
247     }
248     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
249     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
250     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
251     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
252     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
253   } else {
254     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
255   }
256 
257   /* Sanity checks */
258   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
259   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
260   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);
261 
262   /* Just set primal dofs and return */
263   if (setprimal) {
264     IS       enedfieldlocal;
265     PetscInt *eidxs;
266 
267     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
268     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
269     if (nedfieldlocal) {
270       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
271       for (i=0,cum=0;i<ne;i++) {
272         if (PetscRealPart(vals[idxs[i]]) > 2.) {
273           eidxs[cum++] = idxs[i];
274         }
275       }
276       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
277     } else {
278       for (i=0,cum=0;i<ne;i++) {
279         if (PetscRealPart(vals[i]) > 2.) {
280           eidxs[cum++] = i;
281         }
282       }
283     }
284     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
285     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
286     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
287     ierr = PetscFree(eidxs);CHKERRQ(ierr);
288     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
289     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
290     PetscFunctionReturn(0);
291   }
292 
293   /* Compute some l2g maps */
294   if (nedfieldlocal) {
295     IS is;
296 
297     /* need to map from the local Nedelec field to local numbering */
298     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
300     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
301     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
302     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
303     if (global) {
304       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
305       el2g = al2g;
306     } else {
307       IS gis;
308 
309       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
310       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
311       ierr = ISDestroy(&gis);CHKERRQ(ierr);
312     }
313     ierr = ISDestroy(&is);CHKERRQ(ierr);
314   } else {
315     /* restore default */
316     pcbddc->nedfield = -1;
317     /* one ref for the destruction of al2g, one for el2g */
318     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
319     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
320     el2g = al2g;
321     fl2g = NULL;
322   }
323 
324   /* Start communication to drop connections for interior edges (for cc analysis only) */
325   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
326   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
327   if (nedfieldlocal) {
328     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
330     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
331   } else {
332     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
333   }
334   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
335   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
336 
337   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
338     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
339     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
340     if (global) {
341       PetscInt rst;
342 
343       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
344       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
345         if (matis->sf_rootdata[i] < 2) {
346           matis->sf_rootdata[cum++] = i + rst;
347         }
348       }
349       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
350       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
351     } else {
352       PetscInt *tbz;
353 
354       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
355       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
356       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
357       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       for (i=0,cum=0;i<ne;i++)
359         if (matis->sf_leafdata[idxs[i]] == 1)
360           tbz[cum++] = i;
361       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
362       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
363       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
364       ierr = PetscFree(tbz);CHKERRQ(ierr);
365     }
366   } else { /* we need the entire G to infer the nullspace */
367     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
368     G    = pcbddc->discretegradient;
369   }
370 
371   /* Extract subdomain relevant rows of G */
372   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
374   ierr = MatGetSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
375   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
376   ierr = ISDestroy(&lned);CHKERRQ(ierr);
377   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
378   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
379   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
380 
381   /* SF for nodal dofs communications */
382   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
383   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
384   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
386   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
388   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
389   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
390   i    = singular ? 2 : 1;
391   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
392 
393   /* Destroy temporary G created in MATIS format and modified G */
394   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
395   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
396   ierr = MatDestroy(&G);CHKERRQ(ierr);
397 
398   if (print) {
399     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
400     ierr = MatView(lG,NULL);CHKERRQ(ierr);
401   }
402 
403   /* Save lG for values insertion in change of basis */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
405 
406   /* Analyze the edge-nodes connections (duplicate lG) */
407   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
408   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
411   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
412   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
413   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
414   /* need to import the boundary specification to ensure the
415      proper detection of coarse edges' endpoints */
416   if (pcbddc->DirichletBoundariesLocal) {
417     IS is;
418 
419     if (fl2g) {
420       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
421     } else {
422       is = pcbddc->DirichletBoundariesLocal;
423     }
424     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
425     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
426     for (i=0;i<cum;i++) {
427       if (idxs[i] >= 0) {
428         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
429         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
430       }
431     }
432     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
433     if (fl2g) {
434       ierr = ISDestroy(&is);CHKERRQ(ierr);
435     }
436   }
437   if (pcbddc->NeumannBoundariesLocal) {
438     IS is;
439 
440     if (fl2g) {
441       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
442     } else {
443       is = pcbddc->NeumannBoundariesLocal;
444     }
445     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
446     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
447     for (i=0;i<cum;i++) {
448       if (idxs[i] >= 0) {
449         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
450       }
451     }
452     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
453     if (fl2g) {
454       ierr = ISDestroy(&is);CHKERRQ(ierr);
455     }
456   }
457 
458   /* Count neighs per dof */
459   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
460   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
461   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
462   for (i=1,cum=0;i<n_neigh;i++) {
463     cum += n_shared[i];
464     for (j=0;j<n_shared[i];j++) {
465       ecount[shared[i][j]]++;
466     }
467   }
468   if (ne) {
469     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
470   }
471   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
472   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
473   for (i=1;i<n_neigh;i++) {
474     for (j=0;j<n_shared[i];j++) {
475       PetscInt k = shared[i][j];
476       eneighs[k][ecount[k]] = neigh[i];
477       ecount[k]++;
478     }
479   }
480   for (i=0;i<ne;i++) {
481     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
482   }
483   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
484   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
485   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
486   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
487   for (i=1,cum=0;i<n_neigh;i++) {
488     cum += n_shared[i];
489     for (j=0;j<n_shared[i];j++) {
490       vcount[shared[i][j]]++;
491     }
492   }
493   if (nv) {
494     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
495   }
496   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
497   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
498   for (i=1;i<n_neigh;i++) {
499     for (j=0;j<n_shared[i];j++) {
500       PetscInt k = shared[i][j];
501       vneighs[k][vcount[k]] = neigh[i];
502       vcount[k]++;
503     }
504   }
505   for (i=0;i<nv;i++) {
506     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
507   }
508   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
509 
510   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
511      for proper detection of coarse edges' endpoints */
512   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
513   for (i=0;i<ne;i++) {
514     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
515       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
516     }
517   }
518   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
519   if (!conforming) {
520     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
521     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
522   }
523   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
525   cum  = 0;
526   for (i=0;i<ne;i++) {
527     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
528     if (!PetscBTLookup(btee,i)) {
529       marks[cum++] = i;
530       continue;
531     }
532     /* set badly connected edge dofs as primal */
533     if (!conforming) {
534       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
535         marks[cum++] = i;
536         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
537         for (j=ii[i];j<ii[i+1];j++) {
538           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
539         }
540       } else {
541         /* every edge dofs should be connected trough a certain number of nodal dofs
542            to other edge dofs belonging to coarse edges
543            - at most 2 endpoints
544            - order-1 interior nodal dofs
545            - no undefined nodal dofs (nconn < order)
546         */
547         PetscInt ends = 0,ints = 0, undef = 0;
548         for (j=ii[i];j<ii[i+1];j++) {
549           PetscInt v = jj[j],k;
550           PetscInt nconn = iit[v+1]-iit[v];
551           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
552           if (nconn > order) ends++;
553           else if (nconn == order) ints++;
554           else undef++;
555         }
556         if (undef || ends > 2 || ints != order -1) {
557           marks[cum++] = i;
558           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
559           for (j=ii[i];j<ii[i+1];j++) {
560             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
561           }
562         }
563       }
564     }
565     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
566     if (!order && ii[i+1] != ii[i]) {
567       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
568       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
569     }
570   }
571   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
572   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
573   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
574   if (!conforming) {
575     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
576     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
577   }
578   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
579 
580   /* identify splitpoints and corner candidates */
581   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
582   if (print) {
583     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
584     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
585     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
586     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
587   }
588   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
589   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
590   for (i=0;i<nv;i++) {
591     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
592     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
593     if (!order) { /* variable order */
594       PetscReal vorder = 0.;
595 
596       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
597       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
598       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
599       ord  = 1;
600     }
601 #if defined(PETSC_USE_DEBUG)
602     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);
603 #endif
604     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
605       if (PetscBTLookup(btbd,jj[j])) {
606         bdir = PETSC_TRUE;
607         break;
608       }
609       if (vc != ecount[jj[j]]) {
610         sneighs = PETSC_FALSE;
611       } else {
612         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
613         for (k=0;k<vc;k++) {
614           if (vn[k] != en[k]) {
615             sneighs = PETSC_FALSE;
616             break;
617           }
618         }
619       }
620     }
621     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
622       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
623       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624     } else if (test == ord) {
625       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
626         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
627         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
628       } else {
629         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
630         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
631       }
632     }
633   }
634   ierr = PetscFree(ecount);CHKERRQ(ierr);
635   ierr = PetscFree(vcount);CHKERRQ(ierr);
636   if (ne) {
637     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
638   }
639   if (nv) {
640     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
641   }
642   ierr = PetscFree(eneighs);CHKERRQ(ierr);
643   ierr = PetscFree(vneighs);CHKERRQ(ierr);
644   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
645 
646   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
647   if (order != 1) {
648     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
649     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
650     for (i=0;i<nv;i++) {
651       if (PetscBTLookup(btvcand,i)) {
652         PetscBool found = PETSC_FALSE;
653         for (j=ii[i];j<ii[i+1] && !found;j++) {
654           PetscInt k,e = jj[j];
655           if (PetscBTLookup(bte,e)) continue;
656           for (k=iit[e];k<iit[e+1];k++) {
657             PetscInt v = jjt[k];
658             if (v != i && PetscBTLookup(btvcand,v)) {
659               found = PETSC_TRUE;
660               break;
661             }
662           }
663         }
664         if (!found) {
665           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
666           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
667         } else {
668           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
669         }
670       }
671     }
672     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
673   }
674   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
675   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
676   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
677 
678   /* Get the local G^T explicitly */
679   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
680   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
681   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
682 
683   /* Mark interior nodal dofs */
684   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
685   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
686   for (i=1;i<n_neigh;i++) {
687     for (j=0;j<n_shared[i];j++) {
688       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
689     }
690   }
691   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
692 
693   /* communicate corners and splitpoints */
694   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
695   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
696   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
697   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
698 
699   if (print) {
700     IS tbz;
701 
702     cum = 0;
703     for (i=0;i<nv;i++)
704       if (sfvleaves[i])
705         vmarks[cum++] = i;
706 
707     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
708     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
709     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
710     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
711   }
712 
713   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
714   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
715   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
716   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
717 
718   /* Zero rows of lGt corresponding to identified corners
719      and interior nodal dofs */
720   cum = 0;
721   for (i=0;i<nv;i++) {
722     if (sfvleaves[i]) {
723       vmarks[cum++] = i;
724       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
725     }
726     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
727   }
728   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
729   if (print) {
730     IS tbz;
731 
732     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
733     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
734     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
735     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
736   }
737   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
738   ierr = PetscFree(vmarks);CHKERRQ(ierr);
739   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
740   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
741 
742   /* Recompute G */
743   ierr = MatDestroy(&lG);CHKERRQ(ierr);
744   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
745   if (print) {
746     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
747     ierr = MatView(lG,NULL);CHKERRQ(ierr);
748     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
749     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
750   }
751 
752   /* Get primal dofs (if any) */
753   cum = 0;
754   for (i=0;i<ne;i++) {
755     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
756   }
757   if (fl2g) {
758     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
759   }
760   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
761   if (print) {
762     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
763     ierr = ISView(primals,NULL);CHKERRQ(ierr);
764   }
765   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
766   /* TODO: what if the user passed in some of them ?  */
767   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
768   ierr = ISDestroy(&primals);CHKERRQ(ierr);
769 
770   /* Compute edge connectivity */
771   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
772   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
773   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
774   if (fl2g) {
775     PetscBT   btf;
776     PetscInt  *iia,*jja,*iiu,*jju;
777     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
778 
779     /* create CSR for all local dofs */
780     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
781     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
782       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);
783       iiu = pcbddc->mat_graph->xadj;
784       jju = pcbddc->mat_graph->adjncy;
785     } else if (pcbddc->use_local_adj) {
786       rest = PETSC_TRUE;
787       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
788     } else {
789       free   = PETSC_TRUE;
790       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
791       iiu[0] = 0;
792       for (i=0;i<n;i++) {
793         iiu[i+1] = i+1;
794         jju[i]   = -1;
795       }
796     }
797 
798     /* import sizes of CSR */
799     iia[0] = 0;
800     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
801 
802     /* overwrite entries corresponding to the Nedelec field */
803     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
804     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
805     for (i=0;i<ne;i++) {
806       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
807       iia[idxs[i]+1] = ii[i+1]-ii[i];
808     }
809 
810     /* iia in CSR */
811     for (i=0;i<n;i++) iia[i+1] += iia[i];
812 
813     /* jja in CSR */
814     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
815     for (i=0;i<n;i++)
816       if (!PetscBTLookup(btf,i))
817         for (j=0;j<iiu[i+1]-iiu[i];j++)
818           jja[iia[i]+j] = jju[iiu[i]+j];
819 
820     /* map edge dofs connectivity */
821     if (jj) {
822       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
823       for (i=0;i<ne;i++) {
824         PetscInt e = idxs[i];
825         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
826       }
827     }
828     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
829     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
830     if (rest) {
831       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
832     }
833     if (free) {
834       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
835     }
836     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
837   } else {
838     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
839   }
840 
841   /* Analyze interface for edge dofs */
842   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
843   pcbddc->mat_graph->twodim = PETSC_FALSE;
844 
845   /* Get coarse edges in the edge space */
846   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
847   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
848 
849   if (fl2g) {
850     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
851     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
852     for (i=0;i<nee;i++) {
853       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
854     }
855   } else {
856     eedges  = alleedges;
857     primals = allprimals;
858   }
859 
860   /* Mark fine edge dofs with their coarse edge id */
861   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
862   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
863   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
864   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
865   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
866   if (print) {
867     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
868     ierr = ISView(primals,NULL);CHKERRQ(ierr);
869   }
870 
871   maxsize = 0;
872   for (i=0;i<nee;i++) {
873     PetscInt size,mark = i+1;
874 
875     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
876     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     for (j=0;j<size;j++) marks[idxs[j]] = mark;
878     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
879     maxsize = PetscMax(maxsize,size);
880   }
881 
882   /* Find coarse edge endpoints */
883   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
884   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
885   for (i=0;i<nee;i++) {
886     PetscInt mark = i+1,size;
887 
888     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
889     if (!size && nedfieldlocal) continue;
890     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
891     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
892     if (print) {
893       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
894       ISView(eedges[i],NULL);
895     }
896     for (j=0;j<size;j++) {
897       PetscInt k, ee = idxs[j];
898       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
899       for (k=ii[ee];k<ii[ee+1];k++) {
900         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
901         if (PetscBTLookup(btv,jj[k])) {
902           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
903         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
904           PetscInt  k2;
905           PetscBool corner = PETSC_FALSE;
906           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
907             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]));
908             /* it's a corner if either is connected with an edge dof belonging to a different cc or
909                if the edge dof lie on the natural part of the boundary */
910             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
911               corner = PETSC_TRUE;
912               break;
913             }
914           }
915           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
916             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
917             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
918           } else {
919             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
920           }
921         }
922       }
923     }
924     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
925   }
926   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
927   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
928   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
929 
930   /* Reset marked primal dofs */
931   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
932   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
933   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
934   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
935 
936   /* Now use the initial lG */
937   ierr = MatDestroy(&lG);CHKERRQ(ierr);
938   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
939   lG   = lGinit;
940   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
941 
942   /* Compute extended cols indices */
943   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
944   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
945   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
946   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
947   i   *= maxsize;
948   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
949   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
950   eerr = PETSC_FALSE;
951   for (i=0;i<nee;i++) {
952     PetscInt size,found = 0;
953 
954     cum  = 0;
955     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
956     if (!size && nedfieldlocal) continue;
957     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
958     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
959     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
960     for (j=0;j<size;j++) {
961       PetscInt k,ee = idxs[j];
962       for (k=ii[ee];k<ii[ee+1];k++) {
963         PetscInt vv = jj[k];
964         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
965         else if (!PetscBTLookupSet(btvc,vv)) found++;
966       }
967     }
968     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
969     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
970     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
971     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
972     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
973     /* it may happen that endpoints are not defined at this point
974        if it is the case, mark this edge for a second pass */
975     if (cum != size -1 || found != 2) {
976       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
977       if (print) {
978         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
979         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
980         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
981         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
982       }
983       eerr = PETSC_TRUE;
984     }
985   }
986   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
987   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
988   if (done) {
989     PetscInt *newprimals;
990 
991     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
992     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
993     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
995     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
996     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
997     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
998     for (i=0;i<nee;i++) {
999       PetscBool has_candidates = PETSC_FALSE;
1000       if (PetscBTLookup(bter,i)) {
1001         PetscInt size,mark = i+1;
1002 
1003         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1004         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1005         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1006         for (j=0;j<size;j++) {
1007           PetscInt k,ee = idxs[j];
1008           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1009           for (k=ii[ee];k<ii[ee+1];k++) {
1010             /* set all candidates located on the edge as corners */
1011             if (PetscBTLookup(btvcand,jj[k])) {
1012               PetscInt k2,vv = jj[k];
1013               has_candidates = PETSC_TRUE;
1014               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1015               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1016               /* set all edge dofs connected to candidate as primals */
1017               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1018                 if (marks[jjt[k2]] == mark) {
1019                   PetscInt k3,ee2 = jjt[k2];
1020                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1021                   newprimals[cum++] = ee2;
1022                   /* finally set the new corners */
1023                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1024                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1025                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1026                   }
1027                 }
1028               }
1029             } else {
1030               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1031             }
1032           }
1033         }
1034         if (!has_candidates) { /* circular edge */
1035           PetscInt k, ee = idxs[0],*tmarks;
1036 
1037           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1038           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1039           for (k=ii[ee];k<ii[ee+1];k++) {
1040             PetscInt k2;
1041             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1042             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1043             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1044           }
1045           for (j=0;j<size;j++) {
1046             if (tmarks[idxs[j]] > 1) {
1047               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1048               newprimals[cum++] = idxs[j];
1049             }
1050           }
1051           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1052         }
1053         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       }
1055       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1056     }
1057     ierr = PetscFree(extcols);CHKERRQ(ierr);
1058     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1059     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1060     if (fl2g) {
1061       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1062       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1063       for (i=0;i<nee;i++) {
1064         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1065       }
1066       ierr = PetscFree(eedges);CHKERRQ(ierr);
1067     }
1068     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1069     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1070     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1071     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1072     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1073     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1074     pcbddc->mat_graph->twodim = PETSC_FALSE;
1075     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1076     if (fl2g) {
1077       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1078       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1079       for (i=0;i<nee;i++) {
1080         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1081       }
1082     } else {
1083       eedges  = alleedges;
1084       primals = allprimals;
1085     }
1086     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1087 
1088     /* Mark again */
1089     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1090     for (i=0;i<nee;i++) {
1091       PetscInt size,mark = i+1;
1092 
1093       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1094       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1096       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1097     }
1098     if (print) {
1099       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1100       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1101     }
1102 
1103     /* Recompute extended cols */
1104     eerr = PETSC_FALSE;
1105     for (i=0;i<nee;i++) {
1106       PetscInt size;
1107 
1108       cum  = 0;
1109       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1110       if (!size && nedfieldlocal) continue;
1111       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1112       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1113       for (j=0;j<size;j++) {
1114         PetscInt k,ee = idxs[j];
1115         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1116       }
1117       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1118       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1119       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1120       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1121       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1122       if (cum != size -1) {
1123         if (print) {
1124           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1126           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1127           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1128         }
1129         eerr = PETSC_TRUE;
1130       }
1131     }
1132   }
1133   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1135   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1136   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1137   /* an error should not occur at this point */
1138   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1139 
1140   /* Check the number of endpoints */
1141   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1142   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1143   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1144   for (i=0;i<nee;i++) {
1145     PetscInt size, found = 0, gc[2];
1146 
1147     /* init with defaults */
1148     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1149     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1150     if (!size && nedfieldlocal) continue;
1151     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1152     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1153     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1154     for (j=0;j<size;j++) {
1155       PetscInt k,ee = idxs[j];
1156       for (k=ii[ee];k<ii[ee+1];k++) {
1157         PetscInt vv = jj[k];
1158         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1159           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1160           corners[i*2+found++] = vv;
1161         }
1162       }
1163     }
1164     if (found != 2) {
1165       PetscInt e;
1166       if (fl2g) {
1167         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1168       } else {
1169         e = idxs[0];
1170       }
1171       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1172     }
1173 
1174     /* get primal dof index on this coarse edge */
1175     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1176     if (gc[0] > gc[1]) {
1177       PetscInt swap  = corners[2*i];
1178       corners[2*i]   = corners[2*i+1];
1179       corners[2*i+1] = swap;
1180     }
1181     cedges[i] = idxs[size-1];
1182     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1183     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1184   }
1185   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1187 
1188 #if defined(PETSC_USE_DEBUG)
1189   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1190      not interfere with neighbouring coarse edges */
1191   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1192   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1193   for (i=0;i<nv;i++) {
1194     PetscInt emax = 0,eemax = 0;
1195 
1196     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1197     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1198     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1199     for (j=1;j<nee+1;j++) {
1200       if (emax < emarks[j]) {
1201         emax = emarks[j];
1202         eemax = j;
1203       }
1204     }
1205     /* not relevant for edges */
1206     if (!eemax) continue;
1207 
1208     for (j=ii[i];j<ii[i+1];j++) {
1209       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1210         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]);
1211       }
1212     }
1213   }
1214   ierr = PetscFree(emarks);CHKERRQ(ierr);
1215   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216 #endif
1217 
1218   /* Compute extended rows indices for edge blocks of the change of basis */
1219   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1220   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1221   extmem *= maxsize;
1222   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1223   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1224   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1225   for (i=0;i<nv;i++) {
1226     PetscInt mark = 0,size,start;
1227 
1228     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1229     for (j=ii[i];j<ii[i+1];j++)
1230       if (marks[jj[j]] && !mark)
1231         mark = marks[jj[j]];
1232 
1233     /* not relevant */
1234     if (!mark) continue;
1235 
1236     /* import extended row */
1237     mark--;
1238     start = mark*extmem+extrowcum[mark];
1239     size = ii[i+1]-ii[i];
1240     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1241     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1242     extrowcum[mark] += size;
1243   }
1244   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1245   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1246   ierr = PetscFree(marks);CHKERRQ(ierr);
1247 
1248   /* Compress extrows */
1249   cum  = 0;
1250   for (i=0;i<nee;i++) {
1251     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1252     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1253     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1254     cum  = PetscMax(cum,size);
1255   }
1256   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1257   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1258   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1259 
1260   /* Workspace for lapack inner calls and VecSetValues */
1261   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1262 
1263   /* Create change of basis matrix (preallocation can be improved) */
1264   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1265   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1266                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1267   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1268   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1269   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1270   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1271   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1272   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1273   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1274 
1275   /* Defaults to identity */
1276   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1277   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1278   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1279   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1280 
1281   /* Create discrete gradient for the coarser level if needed */
1282   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1283   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1284   if (pcbddc->current_level < pcbddc->max_levels) {
1285     ISLocalToGlobalMapping cel2g,cvl2g;
1286     IS                     wis,gwis;
1287     PetscInt               cnv,cne;
1288 
1289     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1290     if (fl2g) {
1291       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1292     } else {
1293       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1294       pcbddc->nedclocal = wis;
1295     }
1296     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1298     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1299     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1300     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1302 
1303     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1304     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1306     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1307     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1308     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1309     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1310 
1311     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1312     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1313     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1314     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1315     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1316     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1317     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1318     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1319   }
1320   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1321 
1322 #if defined(PRINT_GDET)
1323   inc = 0;
1324   lev = pcbddc->current_level;
1325 #endif
1326 
1327   /* Insert values in the change of basis matrix */
1328   for (i=0;i<nee;i++) {
1329     Mat         Gins = NULL, GKins = NULL;
1330     IS          cornersis = NULL;
1331     PetscScalar cvals[2];
1332 
1333     if (pcbddc->nedcG) {
1334       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1335     }
1336     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1337     if (Gins && GKins) {
1338       PetscScalar    *data;
1339       const PetscInt *rows,*cols;
1340       PetscInt       nrh,nch,nrc,ncc;
1341 
1342       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1343       /* H1 */
1344       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1345       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1346       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1348       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1349       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1350       /* complement */
1351       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1352       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1353       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);
1354       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);
1355       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1356       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1357       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1358 
1359       /* coarse discrete gradient */
1360       if (pcbddc->nedcG) {
1361         PetscInt cols[2];
1362 
1363         cols[0] = 2*i;
1364         cols[1] = 2*i+1;
1365         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1366       }
1367       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1368     }
1369     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1370     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1371     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1372     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1373     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1376 
1377   /* Start assembling */
1378   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   if (pcbddc->nedcG) {
1380     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1381   }
1382 
1383   /* Free */
1384   if (fl2g) {
1385     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1386     for (i=0;i<nee;i++) {
1387       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1388     }
1389     ierr = PetscFree(eedges);CHKERRQ(ierr);
1390   }
1391 
1392   /* hack mat_graph with primal dofs on the coarse edges */
1393   {
1394     PCBDDCGraph graph   = pcbddc->mat_graph;
1395     PetscInt    *oqueue = graph->queue;
1396     PetscInt    *ocptr  = graph->cptr;
1397     PetscInt    ncc,*idxs;
1398 
1399     /* find first primal edge */
1400     if (pcbddc->nedclocal) {
1401       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1402     } else {
1403       if (fl2g) {
1404         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1405       }
1406       idxs = cedges;
1407     }
1408     cum = 0;
1409     while (cum < nee && cedges[cum] < 0) cum++;
1410 
1411     /* adapt connected components */
1412     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1413     graph->cptr[0] = 0;
1414     for (i=0,ncc=0;i<graph->ncc;i++) {
1415       PetscInt lc = ocptr[i+1]-ocptr[i];
1416       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1417         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1418         graph->queue[graph->cptr[ncc]] = cedges[cum];
1419         ncc++;
1420         lc--;
1421         cum++;
1422         while (cum < nee && cedges[cum] < 0) cum++;
1423       }
1424       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1425       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1426       ncc++;
1427     }
1428     graph->ncc = ncc;
1429     if (pcbddc->nedclocal) {
1430       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1431     }
1432     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1433   }
1434   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1435   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1436   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1437   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1438 
1439   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1440   ierr = PetscFree(extrow);CHKERRQ(ierr);
1441   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1442   ierr = PetscFree(corners);CHKERRQ(ierr);
1443   ierr = PetscFree(cedges);CHKERRQ(ierr);
1444   ierr = PetscFree(extrows);CHKERRQ(ierr);
1445   ierr = PetscFree(extcols);CHKERRQ(ierr);
1446   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1447 
1448   /* Complete assembling */
1449   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450   if (pcbddc->nedcG) {
1451     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1452 #if 0
1453     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1454     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1455 #endif
1456   }
1457 
1458   /* set change of basis */
1459   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1460   ierr = MatDestroy(&T);CHKERRQ(ierr);
1461 
1462   PetscFunctionReturn(0);
1463 }
1464 
1465 /* the near-null space of BDDC carries information on quadrature weights,
1466    and these can be collinear -> so cheat with MatNullSpaceCreate
1467    and create a suitable set of basis vectors first */
1468 #undef __FUNCT__
1469 #define __FUNCT__ "PCBDDCNullSpaceCreate"
1470 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1471 {
1472   PetscErrorCode ierr;
1473   PetscInt       i;
1474 
1475   PetscFunctionBegin;
1476   for (i=0;i<nvecs;i++) {
1477     PetscInt first,last;
1478 
1479     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1480     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1481     if (i>=first && i < last) {
1482       PetscScalar *data;
1483       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1484       if (!has_const) {
1485         data[i-first] = 1.;
1486       } else {
1487         data[2*i-first] = 1./PetscSqrtReal(2.);
1488         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1489       }
1490       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1491     }
1492     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1493   }
1494   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1495   for (i=0;i<nvecs;i++) { /* reset vectors */
1496     PetscInt first,last;
1497     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1498     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1499     if (i>=first && i < last) {
1500       PetscScalar *data;
1501       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1502       if (!has_const) {
1503         data[i-first] = 0.;
1504       } else {
1505         data[2*i-first] = 0.;
1506         data[2*i-first+1] = 0.;
1507       }
1508       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1509     }
1510     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1511     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1512   }
1513   PetscFunctionReturn(0);
1514 }
1515 
1516 #undef __FUNCT__
1517 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
1518 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1519 {
1520   Mat                    loc_divudotp;
1521   Vec                    p,v,vins,quad_vec,*quad_vecs;
1522   ISLocalToGlobalMapping map;
1523   IS                     *faces,*edges;
1524   PetscScalar            *vals;
1525   const PetscScalar      *array;
1526   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1527   PetscMPIInt            rank;
1528   PetscErrorCode         ierr;
1529 
1530   PetscFunctionBegin;
1531   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1532   if (graph->twodim) {
1533     lmaxneighs = 2;
1534   } else {
1535     lmaxneighs = 1;
1536     for (i=0;i<ne;i++) {
1537       const PetscInt *idxs;
1538       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1539       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1540       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1541     }
1542     lmaxneighs++; /* graph count does not include self */
1543   }
1544   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1545   maxsize = 0;
1546   for (i=0;i<ne;i++) {
1547     PetscInt nn;
1548     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1549     maxsize = PetscMax(maxsize,nn);
1550   }
1551   for (i=0;i<nf;i++) {
1552     PetscInt nn;
1553     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1554     maxsize = PetscMax(maxsize,nn);
1555   }
1556   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1557   /* create vectors to hold quadrature weights */
1558   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1559   if (!transpose) {
1560     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1561   } else {
1562     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1563   }
1564   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1565   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1566   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1567   for (i=0;i<maxneighs;i++) {
1568     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1569     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1570   }
1571 
1572   /* compute local quad vec */
1573   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1574   if (!transpose) {
1575     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1576   } else {
1577     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1578   }
1579   ierr = VecSet(p,1.);CHKERRQ(ierr);
1580   if (!transpose) {
1581     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1582   } else {
1583     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1584   }
1585   if (vl2l) {
1586     ierr = VecGetSubVector(v,vl2l,&vins);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 = VecRestoreSubVector(v,vl2l,&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 #undef __FUNCT__
1641 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
1642 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1643 {
1644   PetscErrorCode ierr;
1645   Vec            local,global;
1646   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1647   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1648 
1649   PetscFunctionBegin;
1650   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1651   /* need to convert from global to local topology information and remove references to information in global ordering */
1652   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1653   if (pcbddc->user_provided_isfordofs) {
1654     if (pcbddc->n_ISForDofs) {
1655       PetscInt i;
1656       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1657       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1658         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1659         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1660       }
1661       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1662       pcbddc->n_ISForDofs = 0;
1663       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1664     }
1665   } else {
1666     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
1667       PetscInt i, n = matis->A->rmap->n;
1668       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1669       if (i > 1) {
1670         pcbddc->n_ISForDofsLocal = i;
1671         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1672         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1673           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1674         }
1675       }
1676     } else {
1677       PetscInt i;
1678       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1679         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680       }
1681     }
1682   }
1683 
1684   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1685     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1686   } else if (pcbddc->DirichletBoundariesLocal) {
1687     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1688   }
1689   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1690     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1691   } else if (pcbddc->NeumannBoundariesLocal) {
1692     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1693   }
1694   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1695     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1696   }
1697   ierr = VecDestroy(&global);CHKERRQ(ierr);
1698   ierr = VecDestroy(&local);CHKERRQ(ierr);
1699 
1700   PetscFunctionReturn(0);
1701 }
1702 
1703 #undef __FUNCT__
1704 #define __FUNCT__ "PCBDDCConsistencyCheckIS"
1705 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1706 {
1707   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1708   PetscErrorCode  ierr;
1709   IS              nis;
1710   const PetscInt  *idxs;
1711   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1712   PetscBool       *ld;
1713 
1714   PetscFunctionBegin;
1715   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1716   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1717   if (mop == MPI_LAND) {
1718     /* init rootdata with true */
1719     ld   = (PetscBool*) matis->sf_rootdata;
1720     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1721   } else {
1722     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1723   }
1724   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1725   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1726   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1727   ld   = (PetscBool*) matis->sf_leafdata;
1728   for (i=0;i<nd;i++)
1729     if (-1 < idxs[i] && idxs[i] < n)
1730       ld[idxs[i]] = PETSC_TRUE;
1731   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1732   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1733   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1734   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1735   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1736   if (mop == MPI_LAND) {
1737     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1738   } else {
1739     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1740   }
1741   for (i=0,nnd=0;i<n;i++)
1742     if (ld[i])
1743       nidxs[nnd++] = i;
1744   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1745   ierr = ISDestroy(is);CHKERRQ(ierr);
1746   *is  = nis;
1747   PetscFunctionReturn(0);
1748 }
1749 
1750 #undef __FUNCT__
1751 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
1752 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1753 {
1754   PC_IS             *pcis = (PC_IS*)(pc->data);
1755   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1756   PetscErrorCode    ierr;
1757 
1758   PetscFunctionBegin;
1759   if (!pcbddc->benign_have_null) {
1760     PetscFunctionReturn(0);
1761   }
1762   if (pcbddc->ChangeOfBasisMatrix) {
1763     Vec swap;
1764 
1765     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1766     swap = pcbddc->work_change;
1767     pcbddc->work_change = r;
1768     r = swap;
1769   }
1770   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1771   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1772   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1773   ierr = VecSet(z,0.);CHKERRQ(ierr);
1774   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1775   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1776   if (pcbddc->ChangeOfBasisMatrix) {
1777     pcbddc->work_change = r;
1778     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1779     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1780   }
1781   PetscFunctionReturn(0);
1782 }
1783 
1784 #undef __FUNCT__
1785 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
1786 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1787 {
1788   PCBDDCBenignMatMult_ctx ctx;
1789   PetscErrorCode          ierr;
1790   PetscBool               apply_right,apply_left,reset_x;
1791 
1792   PetscFunctionBegin;
1793   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1794   if (transpose) {
1795     apply_right = ctx->apply_left;
1796     apply_left = ctx->apply_right;
1797   } else {
1798     apply_right = ctx->apply_right;
1799     apply_left = ctx->apply_left;
1800   }
1801   reset_x = PETSC_FALSE;
1802   if (apply_right) {
1803     const PetscScalar *ax;
1804     PetscInt          nl,i;
1805 
1806     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1807     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1808     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1809     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1810     for (i=0;i<ctx->benign_n;i++) {
1811       PetscScalar    sum,val;
1812       const PetscInt *idxs;
1813       PetscInt       nz,j;
1814       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1815       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1816       sum = 0.;
1817       if (ctx->apply_p0) {
1818         val = ctx->work[idxs[nz-1]];
1819         for (j=0;j<nz-1;j++) {
1820           sum += ctx->work[idxs[j]];
1821           ctx->work[idxs[j]] += val;
1822         }
1823       } else {
1824         for (j=0;j<nz-1;j++) {
1825           sum += ctx->work[idxs[j]];
1826         }
1827       }
1828       ctx->work[idxs[nz-1]] -= sum;
1829       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1830     }
1831     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1832     reset_x = PETSC_TRUE;
1833   }
1834   if (transpose) {
1835     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1836   } else {
1837     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1838   }
1839   if (reset_x) {
1840     ierr = VecResetArray(x);CHKERRQ(ierr);
1841   }
1842   if (apply_left) {
1843     PetscScalar *ay;
1844     PetscInt    i;
1845 
1846     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1847     for (i=0;i<ctx->benign_n;i++) {
1848       PetscScalar    sum,val;
1849       const PetscInt *idxs;
1850       PetscInt       nz,j;
1851       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1852       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1853       val = -ay[idxs[nz-1]];
1854       if (ctx->apply_p0) {
1855         sum = 0.;
1856         for (j=0;j<nz-1;j++) {
1857           sum += ay[idxs[j]];
1858           ay[idxs[j]] += val;
1859         }
1860         ay[idxs[nz-1]] += sum;
1861       } else {
1862         for (j=0;j<nz-1;j++) {
1863           ay[idxs[j]] += val;
1864         }
1865         ay[idxs[nz-1]] = 0.;
1866       }
1867       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1868     }
1869     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1870   }
1871   PetscFunctionReturn(0);
1872 }
1873 
1874 #undef __FUNCT__
1875 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
1876 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1877 {
1878   PetscErrorCode ierr;
1879 
1880   PetscFunctionBegin;
1881   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1882   PetscFunctionReturn(0);
1883 }
1884 
1885 #undef __FUNCT__
1886 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
1887 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1888 {
1889   PetscErrorCode ierr;
1890 
1891   PetscFunctionBegin;
1892   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1893   PetscFunctionReturn(0);
1894 }
1895 
1896 #undef __FUNCT__
1897 #define __FUNCT__ "PCBDDCBenignShellMat"
1898 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1899 {
1900   PC_IS                   *pcis = (PC_IS*)pc->data;
1901   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1902   PCBDDCBenignMatMult_ctx ctx;
1903   PetscErrorCode          ierr;
1904 
1905   PetscFunctionBegin;
1906   if (!restore) {
1907     Mat                A_IB,A_BI;
1908     PetscScalar        *work;
1909     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1910 
1911     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1912     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1913     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1914     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1915     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1916     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1917     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1918     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1919     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1920     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1921     ctx->apply_left = PETSC_TRUE;
1922     ctx->apply_right = PETSC_FALSE;
1923     ctx->apply_p0 = PETSC_FALSE;
1924     ctx->benign_n = pcbddc->benign_n;
1925     if (reuse) {
1926       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1927       ctx->free = PETSC_FALSE;
1928     } else { /* TODO: could be optimized for successive solves */
1929       ISLocalToGlobalMapping N_to_D;
1930       PetscInt               i;
1931 
1932       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1933       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1934       for (i=0;i<pcbddc->benign_n;i++) {
1935         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1936       }
1937       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1938       ctx->free = PETSC_TRUE;
1939     }
1940     ctx->A = pcis->A_IB;
1941     ctx->work = work;
1942     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1943     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1944     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1945     pcis->A_IB = A_IB;
1946 
1947     /* A_BI as A_IB^T */
1948     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1949     pcbddc->benign_original_mat = pcis->A_BI;
1950     pcis->A_BI = A_BI;
1951   } else {
1952     if (!pcbddc->benign_original_mat) {
1953       PetscFunctionReturn(0);
1954     }
1955     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1956     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1957     pcis->A_IB = ctx->A;
1958     ctx->A = NULL;
1959     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1960     pcis->A_BI = pcbddc->benign_original_mat;
1961     pcbddc->benign_original_mat = NULL;
1962     if (ctx->free) {
1963       PetscInt i;
1964       for (i=0;i<ctx->benign_n;i++) {
1965         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1966       }
1967       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1968     }
1969     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1970     ierr = PetscFree(ctx);CHKERRQ(ierr);
1971   }
1972   PetscFunctionReturn(0);
1973 }
1974 
1975 /* used just in bddc debug mode */
1976 #undef __FUNCT__
1977 #define __FUNCT__ "PCBDDCBenignProject"
1978 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1979 {
1980   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1981   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1982   Mat            An;
1983   PetscErrorCode ierr;
1984 
1985   PetscFunctionBegin;
1986   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1987   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1988   if (is1) {
1989     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1990     ierr = MatDestroy(&An);CHKERRQ(ierr);
1991   } else {
1992     *B = An;
1993   }
1994   PetscFunctionReturn(0);
1995 }
1996 
1997 /* TODO: add reuse flag */
1998 #undef __FUNCT__
1999 #define __FUNCT__ "MatSeqAIJCompress"
2000 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2001 {
2002   Mat            Bt;
2003   PetscScalar    *a,*bdata;
2004   const PetscInt *ii,*ij;
2005   PetscInt       m,n,i,nnz,*bii,*bij;
2006   PetscBool      flg_row;
2007   PetscErrorCode ierr;
2008 
2009   PetscFunctionBegin;
2010   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2011   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2012   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2013   nnz = n;
2014   for (i=0;i<ii[n];i++) {
2015     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2016   }
2017   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2018   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2019   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2020   nnz = 0;
2021   bii[0] = 0;
2022   for (i=0;i<n;i++) {
2023     PetscInt j;
2024     for (j=ii[i];j<ii[i+1];j++) {
2025       PetscScalar entry = a[j];
2026       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2027         bij[nnz] = ij[j];
2028         bdata[nnz] = entry;
2029         nnz++;
2030       }
2031     }
2032     bii[i+1] = nnz;
2033   }
2034   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2035   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2036   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2037   {
2038     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2039     b->free_a = PETSC_TRUE;
2040     b->free_ij = PETSC_TRUE;
2041   }
2042   *B = Bt;
2043   PetscFunctionReturn(0);
2044 }
2045 
2046 #undef __FUNCT__
2047 #define __FUNCT__ "MatDetectDisconnectedComponents"
2048 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
2049 {
2050   Mat                    B;
2051   IS                     is_dummy,*cc_n;
2052   ISLocalToGlobalMapping l2gmap_dummy;
2053   PCBDDCGraph            graph;
2054   PetscInt               i,n;
2055   PetscInt               *xadj,*adjncy;
2056   PetscInt               *xadj_filtered,*adjncy_filtered;
2057   PetscBool              flg_row,isseqaij;
2058   PetscErrorCode         ierr;
2059 
2060   PetscFunctionBegin;
2061   if (!A->rmap->N || !A->cmap->N) {
2062     *ncc = 0;
2063     *cc = NULL;
2064     PetscFunctionReturn(0);
2065   }
2066   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2067   if (!isseqaij && filter) {
2068     PetscBool isseqdense;
2069 
2070     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2071     if (!isseqdense) {
2072       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2073     } else { /* TODO: rectangular case and LDA */
2074       PetscScalar *array;
2075       PetscReal   chop=1.e-6;
2076 
2077       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2078       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2079       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2080       for (i=0;i<n;i++) {
2081         PetscInt j;
2082         for (j=i+1;j<n;j++) {
2083           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2084           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2085           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2086         }
2087       }
2088       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2089       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2090     }
2091   } else {
2092     B = A;
2093   }
2094   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2095 
2096   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2097   if (filter) {
2098     PetscScalar *data;
2099     PetscInt    j,cum;
2100 
2101     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2102     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2103     cum = 0;
2104     for (i=0;i<n;i++) {
2105       PetscInt t;
2106 
2107       for (j=xadj[i];j<xadj[i+1];j++) {
2108         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2109           continue;
2110         }
2111         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2112       }
2113       t = xadj_filtered[i];
2114       xadj_filtered[i] = cum;
2115       cum += t;
2116     }
2117     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2118   } else {
2119     xadj_filtered = NULL;
2120     adjncy_filtered = NULL;
2121   }
2122 
2123   /* compute local connected components using PCBDDCGraph */
2124   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2125   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2126   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2127   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2128   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2129   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2130   if (xadj_filtered) {
2131     graph->xadj = xadj_filtered;
2132     graph->adjncy = adjncy_filtered;
2133   } else {
2134     graph->xadj = xadj;
2135     graph->adjncy = adjncy;
2136   }
2137   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2138   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2139   /* partial clean up */
2140   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2141   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2142   if (A != B) {
2143     ierr = MatDestroy(&B);CHKERRQ(ierr);
2144   }
2145 
2146   /* get back data */
2147   if (ncc) *ncc = graph->ncc;
2148   if (cc) {
2149     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2150     for (i=0;i<graph->ncc;i++) {
2151       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);
2152     }
2153     *cc = cc_n;
2154   }
2155   /* clean up graph */
2156   graph->xadj = 0;
2157   graph->adjncy = 0;
2158   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2159   PetscFunctionReturn(0);
2160 }
2161 
2162 #undef __FUNCT__
2163 #define __FUNCT__ "PCBDDCBenignCheck"
2164 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2165 {
2166   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2167   PC_IS*         pcis = (PC_IS*)(pc->data);
2168   IS             dirIS = NULL;
2169   PetscInt       i;
2170   PetscErrorCode ierr;
2171 
2172   PetscFunctionBegin;
2173   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2174   if (zerodiag) {
2175     Mat            A;
2176     Vec            vec3_N;
2177     PetscScalar    *vals;
2178     const PetscInt *idxs;
2179     PetscInt       nz,*count;
2180 
2181     /* p0 */
2182     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2183     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2184     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2185     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2186     for (i=0;i<nz;i++) vals[i] = 1.;
2187     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2188     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2189     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2190     /* v_I */
2191     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2192     for (i=0;i<nz;i++) vals[i] = 0.;
2193     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2194     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2195     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2196     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2197     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2198     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2199     if (dirIS) {
2200       PetscInt n;
2201 
2202       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2203       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2204       for (i=0;i<n;i++) vals[i] = 0.;
2205       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2206       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2207     }
2208     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2209     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2210     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2211     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2212     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2213     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2214     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2215     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]));
2216     ierr = PetscFree(vals);CHKERRQ(ierr);
2217     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2218 
2219     /* there should not be any pressure dofs lying on the interface */
2220     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2221     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2222     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2223     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2224     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2225     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]);
2226     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2227     ierr = PetscFree(count);CHKERRQ(ierr);
2228   }
2229   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2230 
2231   /* check PCBDDCBenignGetOrSetP0 */
2232   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2233   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2234   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2235   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2236   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2237   for (i=0;i<pcbddc->benign_n;i++) {
2238     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2239     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);
2240   }
2241   PetscFunctionReturn(0);
2242 }
2243 
2244 #undef __FUNCT__
2245 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
2246 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2247 {
2248   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2249   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2250   PetscInt       nz,n;
2251   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2252   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2253   PetscErrorCode ierr;
2254 
2255   PetscFunctionBegin;
2256   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2257   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2258   for (n=0;n<pcbddc->benign_n;n++) {
2259     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2260   }
2261   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2262   pcbddc->benign_n = 0;
2263 
2264   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2265      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2266      Checks if all the pressure dofs in each subdomain have a zero diagonal
2267      If not, a change of basis on pressures is not needed
2268      since the local Schur complements are already SPD
2269   */
2270   has_null_pressures = PETSC_TRUE;
2271   have_null = PETSC_TRUE;
2272   if (pcbddc->n_ISForDofsLocal) {
2273     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2274 
2275     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2276     ierr = PetscOptionsInt ("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2277     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2278     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2279     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2280     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2281     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2282     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2283     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2284     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2285     if (!sorted) {
2286       ierr = ISSort(pressures);CHKERRQ(ierr);
2287     }
2288   } else {
2289     pressures = NULL;
2290   }
2291   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2292   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2293   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2294   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2295   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2296   if (!sorted) {
2297     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2298   }
2299   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2300   zerodiag_save = zerodiag;
2301   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2302   if (!nz) {
2303     if (n) have_null = PETSC_FALSE;
2304     has_null_pressures = PETSC_FALSE;
2305     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2306   }
2307   recompute_zerodiag = PETSC_FALSE;
2308   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2309   zerodiag_subs    = NULL;
2310   pcbddc->benign_n = 0;
2311   n_interior_dofs  = 0;
2312   interior_dofs    = NULL;
2313   nneu             = 0;
2314   if (pcbddc->NeumannBoundariesLocal) {
2315     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2316   }
2317   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2318   if (checkb) { /* need to compute interior nodes */
2319     PetscInt n,i,j;
2320     PetscInt n_neigh,*neigh,*n_shared,**shared;
2321     PetscInt *iwork;
2322 
2323     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2324     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2325     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2326     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2327     for (i=1;i<n_neigh;i++)
2328       for (j=0;j<n_shared[i];j++)
2329           iwork[shared[i][j]] += 1;
2330     for (i=0;i<n;i++)
2331       if (!iwork[i])
2332         interior_dofs[n_interior_dofs++] = i;
2333     ierr = PetscFree(iwork);CHKERRQ(ierr);
2334     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2335   }
2336   if (has_null_pressures) {
2337     IS             *subs;
2338     PetscInt       nsubs,i,j,nl;
2339     const PetscInt *idxs;
2340     PetscScalar    *array;
2341     Vec            *work;
2342     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2343 
2344     subs  = pcbddc->local_subs;
2345     nsubs = pcbddc->n_local_subs;
2346     /* 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) */
2347     if (checkb) {
2348       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2349       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2350       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2351       /* work[0] = 1_p */
2352       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2353       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2354       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2355       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2356       /* work[0] = 1_v */
2357       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2358       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2359       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2360       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2361       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2362     }
2363     if (nsubs > 1) {
2364       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2365       for (i=0;i<nsubs;i++) {
2366         ISLocalToGlobalMapping l2g;
2367         IS                     t_zerodiag_subs;
2368         PetscInt               nl;
2369 
2370         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2371         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2372         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2373         if (nl) {
2374           PetscBool valid = PETSC_TRUE;
2375 
2376           if (checkb) {
2377             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2378             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2379             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2380             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2381             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2382             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2383             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2384             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2385             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2386             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2387             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2388             for (j=0;j<n_interior_dofs;j++) {
2389               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2390                 valid = PETSC_FALSE;
2391                 break;
2392               }
2393             }
2394             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2395           }
2396           if (valid && nneu) {
2397             const PetscInt *idxs;
2398             PetscInt       nzb;
2399 
2400             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2401             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2402             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2403             if (nzb) valid = PETSC_FALSE;
2404           }
2405           if (valid && pressures) {
2406             IS t_pressure_subs;
2407             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2408             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2409             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2410           }
2411           if (valid) {
2412             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2413             pcbddc->benign_n++;
2414           } else {
2415             recompute_zerodiag = PETSC_TRUE;
2416           }
2417         }
2418         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2419         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2420       }
2421     } else { /* there's just one subdomain (or zero if they have not been detected */
2422       PetscBool valid = PETSC_TRUE;
2423 
2424       if (nneu) valid = PETSC_FALSE;
2425       if (valid && pressures) {
2426         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2427       }
2428       if (valid && checkb) {
2429         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2430         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2431         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2432         for (j=0;j<n_interior_dofs;j++) {
2433           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2434             valid = PETSC_FALSE;
2435             break;
2436           }
2437         }
2438         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2439       }
2440       if (valid) {
2441         pcbddc->benign_n = 1;
2442         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2443         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2444         zerodiag_subs[0] = zerodiag;
2445       }
2446     }
2447     if (checkb) {
2448       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2449     }
2450   }
2451   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2452 
2453   if (!pcbddc->benign_n) {
2454     PetscInt n;
2455 
2456     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2457     recompute_zerodiag = PETSC_FALSE;
2458     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2459     if (n) {
2460       has_null_pressures = PETSC_FALSE;
2461       have_null = PETSC_FALSE;
2462     }
2463   }
2464 
2465   /* final check for null pressures */
2466   if (zerodiag && pressures) {
2467     PetscInt nz,np;
2468     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2469     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2470     if (nz != np) have_null = PETSC_FALSE;
2471   }
2472 
2473   if (recompute_zerodiag) {
2474     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2475     if (pcbddc->benign_n == 1) {
2476       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2477       zerodiag = zerodiag_subs[0];
2478     } else {
2479       PetscInt i,nzn,*new_idxs;
2480 
2481       nzn = 0;
2482       for (i=0;i<pcbddc->benign_n;i++) {
2483         PetscInt ns;
2484         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2485         nzn += ns;
2486       }
2487       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2488       nzn = 0;
2489       for (i=0;i<pcbddc->benign_n;i++) {
2490         PetscInt ns,*idxs;
2491         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2492         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2493         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2494         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2495         nzn += ns;
2496       }
2497       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2498       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2499     }
2500     have_null = PETSC_FALSE;
2501   }
2502 
2503   /* Prepare matrix to compute no-net-flux */
2504   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2505     Mat                    A,loc_divudotp;
2506     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2507     IS                     row,col,isused = NULL;
2508     PetscInt               M,N,n,st,n_isused;
2509 
2510     if (pressures) {
2511       isused = pressures;
2512     } else {
2513       isused = zerodiag_save;
2514     }
2515     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2516     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2517     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2518     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");
2519     n_isused = 0;
2520     if (isused) {
2521       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2522     }
2523     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2524     st = st-n_isused;
2525     if (n) {
2526       const PetscInt *gidxs;
2527 
2528       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2529       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2530       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2531       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2532       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2533       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2534     } else {
2535       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2536       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2537       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2538     }
2539     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2540     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2541     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2542     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2543     ierr = ISDestroy(&row);CHKERRQ(ierr);
2544     ierr = ISDestroy(&col);CHKERRQ(ierr);
2545     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2546     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2547     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2548     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2549     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2550     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2551     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2552     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2553     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2554     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2555   }
2556   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2557 
2558   /* change of basis and p0 dofs */
2559   if (has_null_pressures) {
2560     IS             zerodiagc;
2561     const PetscInt *idxs,*idxsc;
2562     PetscInt       i,s,*nnz;
2563 
2564     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2565     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2566     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2567     /* local change of basis for pressures */
2568     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2569     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2570     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2571     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2572     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2573     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2574     for (i=0;i<pcbddc->benign_n;i++) {
2575       PetscInt nzs,j;
2576 
2577       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2578       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2579       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2580       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2581       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2582     }
2583     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2584     ierr = PetscFree(nnz);CHKERRQ(ierr);
2585     /* set identity on velocities */
2586     for (i=0;i<n-nz;i++) {
2587       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2588     }
2589     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2590     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2591     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2592     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2593     /* set change on pressures */
2594     for (s=0;s<pcbddc->benign_n;s++) {
2595       PetscScalar *array;
2596       PetscInt    nzs;
2597 
2598       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2599       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2600       for (i=0;i<nzs-1;i++) {
2601         PetscScalar vals[2];
2602         PetscInt    cols[2];
2603 
2604         cols[0] = idxs[i];
2605         cols[1] = idxs[nzs-1];
2606         vals[0] = 1.;
2607         vals[1] = 1.;
2608         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2609       }
2610       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2611       for (i=0;i<nzs-1;i++) array[i] = -1.;
2612       array[nzs-1] = 1.;
2613       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2614       /* store local idxs for p0 */
2615       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2616       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2617       ierr = PetscFree(array);CHKERRQ(ierr);
2618     }
2619     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2620     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2621     /* project if needed */
2622     if (pcbddc->benign_change_explicit) {
2623       Mat M;
2624 
2625       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2626       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2627       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2628       ierr = MatDestroy(&M);CHKERRQ(ierr);
2629     }
2630     /* store global idxs for p0 */
2631     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2632   }
2633   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2634   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2635 
2636   /* determines if the coarse solver will be singular or not */
2637   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2638   /* determines if the problem has subdomains with 0 pressure block */
2639   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2640   *zerodiaglocal = zerodiag;
2641   PetscFunctionReturn(0);
2642 }
2643 
2644 #undef __FUNCT__
2645 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
2646 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2647 {
2648   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2649   PetscScalar    *array;
2650   PetscErrorCode ierr;
2651 
2652   PetscFunctionBegin;
2653   if (!pcbddc->benign_sf) {
2654     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2655     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2656   }
2657   if (get) {
2658     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2659     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2660     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2661     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2662   } else {
2663     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2664     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2665     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2666     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2667   }
2668   PetscFunctionReturn(0);
2669 }
2670 
2671 #undef __FUNCT__
2672 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
2673 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2674 {
2675   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2676   PetscErrorCode ierr;
2677 
2678   PetscFunctionBegin;
2679   /* TODO: add error checking
2680     - avoid nested pop (or push) calls.
2681     - cannot push before pop.
2682     - cannot call this if pcbddc->local_mat is NULL
2683   */
2684   if (!pcbddc->benign_n) {
2685     PetscFunctionReturn(0);
2686   }
2687   if (pop) {
2688     if (pcbddc->benign_change_explicit) {
2689       IS       is_p0;
2690       MatReuse reuse;
2691 
2692       /* extract B_0 */
2693       reuse = MAT_INITIAL_MATRIX;
2694       if (pcbddc->benign_B0) {
2695         reuse = MAT_REUSE_MATRIX;
2696       }
2697       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2698       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2699       /* remove rows and cols from local problem */
2700       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2701       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2702       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2703       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2704     } else {
2705       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2706       PetscScalar *vals;
2707       PetscInt    i,n,*idxs_ins;
2708 
2709       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2710       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2711       if (!pcbddc->benign_B0) {
2712         PetscInt *nnz;
2713         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2714         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2715         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2716         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2717         for (i=0;i<pcbddc->benign_n;i++) {
2718           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2719           nnz[i] = n - nnz[i];
2720         }
2721         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2722         ierr = PetscFree(nnz);CHKERRQ(ierr);
2723       }
2724 
2725       for (i=0;i<pcbddc->benign_n;i++) {
2726         PetscScalar *array;
2727         PetscInt    *idxs,j,nz,cum;
2728 
2729         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2730         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2731         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2732         for (j=0;j<nz;j++) vals[j] = 1.;
2733         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2734         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2735         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2736         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2737         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2738         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2739         cum = 0;
2740         for (j=0;j<n;j++) {
2741           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2742             vals[cum] = array[j];
2743             idxs_ins[cum] = j;
2744             cum++;
2745           }
2746         }
2747         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2748         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2749         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2750       }
2751       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2752       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2753       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2754     }
2755   } else { /* push */
2756     if (pcbddc->benign_change_explicit) {
2757       PetscInt i;
2758 
2759       for (i=0;i<pcbddc->benign_n;i++) {
2760         PetscScalar *B0_vals;
2761         PetscInt    *B0_cols,B0_ncol;
2762 
2763         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2764         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2765         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2766         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2767         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2768       }
2769       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2770       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2771     } else {
2772       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2773     }
2774   }
2775   PetscFunctionReturn(0);
2776 }
2777 
2778 #undef __FUNCT__
2779 #define __FUNCT__ "PCBDDCAdaptiveSelection"
2780 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2781 {
2782   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2783   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2784   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2785   PetscBLASInt    *B_iwork,*B_ifail;
2786   PetscScalar     *work,lwork;
2787   PetscScalar     *St,*S,*eigv;
2788   PetscScalar     *Sarray,*Starray;
2789   PetscReal       *eigs,thresh;
2790   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2791   PetscBool       allocated_S_St;
2792 #if defined(PETSC_USE_COMPLEX)
2793   PetscReal       *rwork;
2794 #endif
2795   PetscErrorCode  ierr;
2796 
2797   PetscFunctionBegin;
2798   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2799   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2800   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)\n",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2801 
2802   if (pcbddc->dbg_flag) {
2803     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2804     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2806     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2807   }
2808 
2809   if (pcbddc->dbg_flag) {
2810     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2811   }
2812 
2813   /* max size of subsets */
2814   mss = 0;
2815   for (i=0;i<sub_schurs->n_subs;i++) {
2816     PetscInt subset_size;
2817 
2818     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2819     mss = PetscMax(mss,subset_size);
2820   }
2821 
2822   /* min/max and threshold */
2823   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2824   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2825   nmax = PetscMax(nmin,nmax);
2826   allocated_S_St = PETSC_FALSE;
2827   if (nmin) {
2828     allocated_S_St = PETSC_TRUE;
2829   }
2830 
2831   /* allocate lapack workspace */
2832   cum = cum2 = 0;
2833   maxneigs = 0;
2834   for (i=0;i<sub_schurs->n_subs;i++) {
2835     PetscInt n,subset_size;
2836 
2837     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2838     n = PetscMin(subset_size,nmax);
2839     cum += subset_size;
2840     cum2 += subset_size*n;
2841     maxneigs = PetscMax(maxneigs,n);
2842   }
2843   if (mss) {
2844     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2845       PetscBLASInt B_itype = 1;
2846       PetscBLASInt B_N = mss;
2847       PetscReal    zero = 0.0;
2848       PetscReal    eps = 0.0; /* dlamch? */
2849 
2850       B_lwork = -1;
2851       S = NULL;
2852       St = NULL;
2853       eigs = NULL;
2854       eigv = NULL;
2855       B_iwork = NULL;
2856       B_ifail = NULL;
2857 #if defined(PETSC_USE_COMPLEX)
2858       rwork = NULL;
2859 #endif
2860       thresh = 1.0;
2861       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2862 #if defined(PETSC_USE_COMPLEX)
2863       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));
2864 #else
2865       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));
2866 #endif
2867       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2868       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2869     } else {
2870         /* TODO */
2871     }
2872   } else {
2873     lwork = 0;
2874   }
2875 
2876   nv = 0;
2877   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) */
2878     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2879   }
2880   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2881   if (allocated_S_St) {
2882     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2883   }
2884   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2885 #if defined(PETSC_USE_COMPLEX)
2886   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2887 #endif
2888   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2889                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2890                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2891                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2892                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2893   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2894 
2895   maxneigs = 0;
2896   cum = cumarray = 0;
2897   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2898   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2899   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2900     const PetscInt *idxs;
2901 
2902     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2903     for (cum=0;cum<nv;cum++) {
2904       pcbddc->adaptive_constraints_n[cum] = 1;
2905       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2906       pcbddc->adaptive_constraints_data[cum] = 1.0;
2907       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2908       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2909     }
2910     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2911   }
2912 
2913   if (mss) { /* multilevel */
2914     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2915     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2916   }
2917 
2918   thresh = pcbddc->adaptive_threshold;
2919   for (i=0;i<sub_schurs->n_subs;i++) {
2920     const PetscInt *idxs;
2921     PetscReal      upper,lower;
2922     PetscInt       j,subset_size,eigs_start = 0;
2923     PetscBLASInt   B_N;
2924     PetscBool      same_data = PETSC_FALSE;
2925 
2926     if (pcbddc->use_deluxe_scaling) {
2927       upper = PETSC_MAX_REAL;
2928       lower = thresh;
2929     } else {
2930       upper = 1./thresh;
2931       lower = 0.;
2932     }
2933     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2934     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2935     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2936     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2937       if (sub_schurs->is_hermitian) {
2938         PetscInt j,k;
2939         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2940           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2941           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2942         }
2943         for (j=0;j<subset_size;j++) {
2944           for (k=j;k<subset_size;k++) {
2945             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2946             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2947           }
2948         }
2949       } else {
2950         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2951         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2952       }
2953     } else {
2954       S = Sarray + cumarray;
2955       St = Starray + cumarray;
2956     }
2957     /* see if we can save some work */
2958     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2959       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2960     }
2961 
2962     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2963       B_neigs = 0;
2964     } else {
2965       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2966         PetscBLASInt B_itype = 1;
2967         PetscBLASInt B_IL, B_IU;
2968         PetscReal    eps = -1.0; /* dlamch? */
2969         PetscInt     nmin_s;
2970         PetscBool    compute_range = PETSC_FALSE;
2971 
2972         if (pcbddc->dbg_flag) {
2973           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]]);
2974         }
2975 
2976         compute_range = PETSC_FALSE;
2977         if (thresh > 1.+PETSC_SMALL && !same_data) {
2978           compute_range = PETSC_TRUE;
2979         }
2980 
2981         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2982         if (compute_range) {
2983 
2984           /* ask for eigenvalues larger than thresh */
2985 #if defined(PETSC_USE_COMPLEX)
2986           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));
2987 #else
2988           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));
2989 #endif
2990         } else if (!same_data) {
2991           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2992           B_IL = 1;
2993 #if defined(PETSC_USE_COMPLEX)
2994           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));
2995 #else
2996           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));
2997 #endif
2998         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2999           PetscInt k;
3000           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3001           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3002           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3003           nmin = nmax;
3004           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3005           for (k=0;k<nmax;k++) {
3006             eigs[k] = 1./PETSC_SMALL;
3007             eigv[k*(subset_size+1)] = 1.0;
3008           }
3009         }
3010         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3011         if (B_ierr) {
3012           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3013           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);
3014           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);
3015         }
3016 
3017         if (B_neigs > nmax) {
3018           if (pcbddc->dbg_flag) {
3019             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3020           }
3021           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3022           B_neigs = nmax;
3023         }
3024 
3025         nmin_s = PetscMin(nmin,B_N);
3026         if (B_neigs < nmin_s) {
3027           PetscBLASInt B_neigs2;
3028 
3029           if (pcbddc->use_deluxe_scaling) {
3030             B_IL = B_N - nmin_s + 1;
3031             B_IU = B_N - B_neigs;
3032           } else {
3033             B_IL = B_neigs + 1;
3034             B_IU = nmin_s;
3035           }
3036           if (pcbddc->dbg_flag) {
3037             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);
3038           }
3039           if (sub_schurs->is_hermitian) {
3040             PetscInt j,k;
3041             for (j=0;j<subset_size;j++) {
3042               for (k=j;k<subset_size;k++) {
3043                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3044                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3045               }
3046             }
3047           } else {
3048             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3049             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3050           }
3051           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3052 #if defined(PETSC_USE_COMPLEX)
3053           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));
3054 #else
3055           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));
3056 #endif
3057           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3058           B_neigs += B_neigs2;
3059         }
3060         if (B_ierr) {
3061           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3062           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);
3063           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);
3064         }
3065         if (pcbddc->dbg_flag) {
3066           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3067           for (j=0;j<B_neigs;j++) {
3068             if (eigs[j] == 0.0) {
3069               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3070             } else {
3071               if (pcbddc->use_deluxe_scaling) {
3072                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3073               } else {
3074                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3075               }
3076             }
3077           }
3078         }
3079       } else {
3080           /* TODO */
3081       }
3082     }
3083     /* change the basis back to the original one */
3084     if (sub_schurs->change) {
3085       Mat change,phi,phit;
3086 
3087       if (pcbddc->dbg_flag > 1) {
3088         PetscInt ii;
3089         for (ii=0;ii<B_neigs;ii++) {
3090           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3091           for (j=0;j<B_N;j++) {
3092 #if defined(PETSC_USE_COMPLEX)
3093             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3094             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3095             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3096 #else
3097             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3098 #endif
3099           }
3100         }
3101       }
3102       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3103       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3104       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3105       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3106       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3107       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3108     }
3109     maxneigs = PetscMax(B_neigs,maxneigs);
3110     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3111     if (B_neigs) {
3112       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);
3113 
3114       if (pcbddc->dbg_flag > 1) {
3115         PetscInt ii;
3116         for (ii=0;ii<B_neigs;ii++) {
3117           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3118           for (j=0;j<B_N;j++) {
3119 #if defined(PETSC_USE_COMPLEX)
3120             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3121             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3122             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3123 #else
3124             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3125 #endif
3126           }
3127         }
3128       }
3129       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3130       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3131       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3132       cum++;
3133     }
3134     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3135     /* shift for next computation */
3136     cumarray += subset_size*subset_size;
3137   }
3138   if (pcbddc->dbg_flag) {
3139     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3140   }
3141 
3142   if (mss) {
3143     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3144     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3145     /* destroy matrices (junk) */
3146     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3147     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3148   }
3149   if (allocated_S_St) {
3150     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3151   }
3152   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3153 #if defined(PETSC_USE_COMPLEX)
3154   ierr = PetscFree(rwork);CHKERRQ(ierr);
3155 #endif
3156   if (pcbddc->dbg_flag) {
3157     PetscInt maxneigs_r;
3158     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3159     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3160   }
3161   PetscFunctionReturn(0);
3162 }
3163 
3164 #undef __FUNCT__
3165 #define __FUNCT__ "PCBDDCSetUpSolvers"
3166 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3167 {
3168   PetscScalar    *coarse_submat_vals;
3169   PetscErrorCode ierr;
3170 
3171   PetscFunctionBegin;
3172   /* Setup local scatters R_to_B and (optionally) R_to_D */
3173   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3174   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3175 
3176   /* Setup local neumann solver ksp_R */
3177   /* PCBDDCSetUpLocalScatters should be called first! */
3178   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3179 
3180   /*
3181      Setup local correction and local part of coarse basis.
3182      Gives back the dense local part of the coarse matrix in column major ordering
3183   */
3184   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3185 
3186   /* Compute total number of coarse nodes and setup coarse solver */
3187   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3188 
3189   /* free */
3190   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3191   PetscFunctionReturn(0);
3192 }
3193 
3194 #undef __FUNCT__
3195 #define __FUNCT__ "PCBDDCResetCustomization"
3196 PetscErrorCode PCBDDCResetCustomization(PC pc)
3197 {
3198   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3199   PetscErrorCode ierr;
3200 
3201   PetscFunctionBegin;
3202   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3203   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3204   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3205   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3206   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3207   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3208   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3209   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3210   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3211   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3212   PetscFunctionReturn(0);
3213 }
3214 
3215 #undef __FUNCT__
3216 #define __FUNCT__ "PCBDDCResetTopography"
3217 PetscErrorCode PCBDDCResetTopography(PC pc)
3218 {
3219   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3220   PetscInt       i;
3221   PetscErrorCode ierr;
3222 
3223   PetscFunctionBegin;
3224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3226   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3227   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3228   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3229   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3230   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3231   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3232   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3233   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3234   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
3235   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
3236   for (i=0;i<pcbddc->n_local_subs;i++) {
3237     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3238   }
3239   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3240   if (pcbddc->sub_schurs) {
3241     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
3242   }
3243   pcbddc->graphanalyzed        = PETSC_FALSE;
3244   pcbddc->recompute_topography = PETSC_TRUE;
3245   PetscFunctionReturn(0);
3246 }
3247 
3248 #undef __FUNCT__
3249 #define __FUNCT__ "PCBDDCResetSolvers"
3250 PetscErrorCode PCBDDCResetSolvers(PC pc)
3251 {
3252   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3253   PetscErrorCode ierr;
3254 
3255   PetscFunctionBegin;
3256   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3257   if (pcbddc->coarse_phi_B) {
3258     PetscScalar *array;
3259     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3260     ierr = PetscFree(array);CHKERRQ(ierr);
3261   }
3262   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3263   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3264   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3265   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3266   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3267   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3268   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3269   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3270   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3271   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3272   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3273   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3274   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3275   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3276   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
3277   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
3278   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
3279   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3280   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3281   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3282   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3283   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3284   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3285   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3286   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3287   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3288   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3289   if (pcbddc->benign_zerodiag_subs) {
3290     PetscInt i;
3291     for (i=0;i<pcbddc->benign_n;i++) {
3292       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3293     }
3294     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3295   }
3296   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3297   PetscFunctionReturn(0);
3298 }
3299 
3300 #undef __FUNCT__
3301 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
3302 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3303 {
3304   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3305   PC_IS          *pcis = (PC_IS*)pc->data;
3306   VecType        impVecType;
3307   PetscInt       n_constraints,n_R,old_size;
3308   PetscErrorCode ierr;
3309 
3310   PetscFunctionBegin;
3311   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3312   n_R = pcis->n - pcbddc->n_vertices;
3313   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3314   /* local work vectors (try to avoid unneeded work)*/
3315   /* R nodes */
3316   old_size = -1;
3317   if (pcbddc->vec1_R) {
3318     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3319   }
3320   if (n_R != old_size) {
3321     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3322     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3323     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3324     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3325     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3326     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3327   }
3328   /* local primal dofs */
3329   old_size = -1;
3330   if (pcbddc->vec1_P) {
3331     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3332   }
3333   if (pcbddc->local_primal_size != old_size) {
3334     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3335     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3336     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3337     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3338   }
3339   /* local explicit constraints */
3340   old_size = -1;
3341   if (pcbddc->vec1_C) {
3342     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3343   }
3344   if (n_constraints && n_constraints != old_size) {
3345     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3346     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3347     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3348     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3349   }
3350   PetscFunctionReturn(0);
3351 }
3352 
3353 #undef __FUNCT__
3354 #define __FUNCT__ "PCBDDCSetUpCorrection"
3355 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3356 {
3357   PetscErrorCode  ierr;
3358   /* pointers to pcis and pcbddc */
3359   PC_IS*          pcis = (PC_IS*)pc->data;
3360   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3361   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3362   /* submatrices of local problem */
3363   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3364   /* submatrices of local coarse problem */
3365   Mat             S_VV,S_CV,S_VC,S_CC;
3366   /* working matrices */
3367   Mat             C_CR;
3368   /* additional working stuff */
3369   PC              pc_R;
3370   Mat             F;
3371   Vec             dummy_vec;
3372   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3373   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3374   PetscScalar     *work;
3375   PetscInt        *idx_V_B;
3376   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3377   PetscInt        i,n_R,n_D,n_B;
3378 
3379   /* some shortcuts to scalars */
3380   PetscScalar     one=1.0,m_one=-1.0;
3381 
3382   PetscFunctionBegin;
3383   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");
3384 
3385   /* Set Non-overlapping dimensions */
3386   n_vertices = pcbddc->n_vertices;
3387   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3388   n_B = pcis->n_B;
3389   n_D = pcis->n - n_B;
3390   n_R = pcis->n - n_vertices;
3391 
3392   /* vertices in boundary numbering */
3393   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3394   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3395   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3396 
3397   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3398   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3399   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3400   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3401   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3402   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3403   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3404   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3405   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3406   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3407 
3408   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3409   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3410   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3411   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3412   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3413   lda_rhs = n_R;
3414   need_benign_correction = PETSC_FALSE;
3415   if (isLU || isILU || isCHOL) {
3416     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3417   } else if (sub_schurs && sub_schurs->reuse_solver) {
3418     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3419     MatFactorType      type;
3420 
3421     F = reuse_solver->F;
3422     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3423     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3424     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3425     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3426   } else {
3427     F = NULL;
3428   }
3429 
3430   /* allocate workspace */
3431   n = 0;
3432   if (n_constraints) {
3433     n += lda_rhs*n_constraints;
3434   }
3435   if (n_vertices) {
3436     n = PetscMax(2*lda_rhs*n_vertices,n);
3437     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3438   }
3439   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3440 
3441   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3442   dummy_vec = NULL;
3443   if (need_benign_correction && lda_rhs != n_R && F) {
3444     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3445   }
3446 
3447   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3448   if (n_constraints) {
3449     Mat         M1,M2,M3,C_B;
3450     IS          is_aux;
3451     PetscScalar *array,*array2;
3452 
3453     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3454     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3455 
3456     /* Extract constraints on R nodes: C_{CR}  */
3457     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3458     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3459     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3460 
3461     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3462     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3463     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3464     for (i=0;i<n_constraints;i++) {
3465       const PetscScalar *row_cmat_values;
3466       const PetscInt    *row_cmat_indices;
3467       PetscInt          size_of_constraint,j;
3468 
3469       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3470       for (j=0;j<size_of_constraint;j++) {
3471         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3472       }
3473       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3474     }
3475     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3476     if (F) {
3477       Mat B;
3478 
3479       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3480       if (need_benign_correction) {
3481         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3482 
3483         /* rhs is already zero on interior dofs, no need to change the rhs */
3484         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3485       }
3486       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3487       if (need_benign_correction) {
3488         PetscScalar        *marr;
3489         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3490 
3491         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3492         if (lda_rhs != n_R) {
3493           for (i=0;i<n_constraints;i++) {
3494             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3495             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3496             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3497           }
3498         } else {
3499           for (i=0;i<n_constraints;i++) {
3500             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3501             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3502             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3503           }
3504         }
3505         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3506       }
3507       ierr = MatDestroy(&B);CHKERRQ(ierr);
3508     } else {
3509       PetscScalar *marr;
3510 
3511       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3512       for (i=0;i<n_constraints;i++) {
3513         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3514         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3515         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3516         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3517         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3518       }
3519       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3520     }
3521     if (!pcbddc->switch_static) {
3522       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3523       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3524       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3525       for (i=0;i<n_constraints;i++) {
3526         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3527         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3528         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3529         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3530         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3531         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3532       }
3533       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3534       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3535       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3536     } else {
3537       if (lda_rhs != n_R) {
3538         IS dummy;
3539 
3540         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3541         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3542         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3543       } else {
3544         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3545         pcbddc->local_auxmat2 = local_auxmat2_R;
3546       }
3547       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3548     }
3549     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3550     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3551     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3552     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3553     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3554     if (isCHOL) {
3555       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3556     } else {
3557       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3558     }
3559     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3560     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3561     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3562     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3563     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3564     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3565     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3566     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3567     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3568     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3569   }
3570 
3571   /* Get submatrices from subdomain matrix */
3572   if (n_vertices) {
3573     IS is_aux;
3574 
3575     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3576       IS tis;
3577 
3578       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3579       ierr = ISSort(tis);CHKERRQ(ierr);
3580       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3581       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3582     } else {
3583       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3584     }
3585     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3586     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3587     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3588     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3589   }
3590 
3591   /* Matrix of coarse basis functions (local) */
3592   if (pcbddc->coarse_phi_B) {
3593     PetscInt on_B,on_primal,on_D=n_D;
3594     if (pcbddc->coarse_phi_D) {
3595       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3596     }
3597     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3598     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3599       PetscScalar *marray;
3600 
3601       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3602       ierr = PetscFree(marray);CHKERRQ(ierr);
3603       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3604       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3605       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3606       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3607     }
3608   }
3609 
3610   if (!pcbddc->coarse_phi_B) {
3611     PetscScalar *marray;
3612 
3613     n = n_B*pcbddc->local_primal_size;
3614     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3615       n += n_D*pcbddc->local_primal_size;
3616     }
3617     if (!pcbddc->symmetric_primal) {
3618       n *= 2;
3619     }
3620     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
3621     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3622     n = n_B*pcbddc->local_primal_size;
3623     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3624       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3625       n += n_D*pcbddc->local_primal_size;
3626     }
3627     if (!pcbddc->symmetric_primal) {
3628       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3629       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3630         n = n_B*pcbddc->local_primal_size;
3631         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3632       }
3633     } else {
3634       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3635       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3636       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3637         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3638         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3639       }
3640     }
3641   }
3642 
3643   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3644   p0_lidx_I = NULL;
3645   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3646     const PetscInt *idxs;
3647 
3648     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3649     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3650     for (i=0;i<pcbddc->benign_n;i++) {
3651       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3652     }
3653     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3654   }
3655 
3656   /* vertices */
3657   if (n_vertices) {
3658 
3659     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3660 
3661     if (n_R) {
3662       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3663       PetscBLASInt B_N,B_one = 1;
3664       PetscScalar  *x,*y;
3665       PetscBool    isseqaij;
3666 
3667       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3668       if (need_benign_correction) {
3669         ISLocalToGlobalMapping RtoN;
3670         IS                     is_p0;
3671         PetscInt               *idxs_p0,n;
3672 
3673         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3674         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3675         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3676         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);
3677         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3678         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3679         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3680         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3681       }
3682 
3683       if (lda_rhs == n_R) {
3684         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3685       } else {
3686         PetscScalar    *av,*array;
3687         const PetscInt *xadj,*adjncy;
3688         PetscInt       n;
3689         PetscBool      flg_row;
3690 
3691         array = work+lda_rhs*n_vertices;
3692         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3693         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3694         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3695         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3696         for (i=0;i<n;i++) {
3697           PetscInt j;
3698           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3699         }
3700         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3701         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3702         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3703       }
3704       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3705       if (need_benign_correction) {
3706         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3707         PetscScalar        *marr;
3708 
3709         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3710         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3711 
3712                | 0 0  0 | (V)
3713            L = | 0 0 -1 | (P-p0)
3714                | 0 0 -1 | (p0)
3715 
3716         */
3717         for (i=0;i<reuse_solver->benign_n;i++) {
3718           const PetscScalar *vals;
3719           const PetscInt    *idxs,*idxs_zero;
3720           PetscInt          n,j,nz;
3721 
3722           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3723           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3724           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3725           for (j=0;j<n;j++) {
3726             PetscScalar val = vals[j];
3727             PetscInt    k,col = idxs[j];
3728             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3729           }
3730           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3731           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3732         }
3733         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3734       }
3735       if (F) {
3736         /* need to correct the rhs */
3737         if (need_benign_correction) {
3738           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3739           PetscScalar        *marr;
3740 
3741           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3742           if (lda_rhs != n_R) {
3743             for (i=0;i<n_vertices;i++) {
3744               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3745               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3746               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3747             }
3748           } else {
3749             for (i=0;i<n_vertices;i++) {
3750               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3751               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3752               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3753             }
3754           }
3755           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3756         }
3757         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3758         /* need to correct the solution */
3759         if (need_benign_correction) {
3760           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3761           PetscScalar        *marr;
3762 
3763           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3764           if (lda_rhs != n_R) {
3765             for (i=0;i<n_vertices;i++) {
3766               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3767               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3768               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3769             }
3770           } else {
3771             for (i=0;i<n_vertices;i++) {
3772               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3773               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3774               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3775             }
3776           }
3777           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3778         }
3779       } else {
3780         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3781         for (i=0;i<n_vertices;i++) {
3782           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3783           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3784           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3785           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3786           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3787         }
3788         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3789       }
3790       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3791       /* S_VV and S_CV */
3792       if (n_constraints) {
3793         Mat B;
3794 
3795         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3796         for (i=0;i<n_vertices;i++) {
3797           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3798           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3799           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3800           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3801           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3802           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3803         }
3804         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3805         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3806         ierr = MatDestroy(&B);CHKERRQ(ierr);
3807         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3808         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3809         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3810         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3811         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3812         ierr = MatDestroy(&B);CHKERRQ(ierr);
3813       }
3814       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3815       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3816         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3817       }
3818       if (lda_rhs != n_R) {
3819         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3820         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3821         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3822       }
3823       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3824       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3825       if (need_benign_correction) {
3826         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3827         PetscScalar      *marr,*sums;
3828 
3829         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3830         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3831         for (i=0;i<reuse_solver->benign_n;i++) {
3832           const PetscScalar *vals;
3833           const PetscInt    *idxs,*idxs_zero;
3834           PetscInt          n,j,nz;
3835 
3836           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3837           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3838           for (j=0;j<n_vertices;j++) {
3839             PetscInt k;
3840             sums[j] = 0.;
3841             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3842           }
3843           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3844           for (j=0;j<n;j++) {
3845             PetscScalar val = vals[j];
3846             PetscInt k;
3847             for (k=0;k<n_vertices;k++) {
3848               marr[idxs[j]+k*n_vertices] += val*sums[k];
3849             }
3850           }
3851           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3852           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3853         }
3854         ierr = PetscFree(sums);CHKERRQ(ierr);
3855         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3856         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3857       }
3858       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3859       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3860       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3861       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3862       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3863       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3864       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3865       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3866       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3867     } else {
3868       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3869     }
3870     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3871 
3872     /* coarse basis functions */
3873     for (i=0;i<n_vertices;i++) {
3874       PetscScalar *y;
3875 
3876       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3877       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3878       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3879       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3880       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3881       y[n_B*i+idx_V_B[i]] = 1.0;
3882       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3883       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3884 
3885       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3886         PetscInt j;
3887 
3888         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3889         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3890         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3891         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3892         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3893         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3894         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3895       }
3896       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3897     }
3898     /* if n_R == 0 the object is not destroyed */
3899     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3900   }
3901   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3902 
3903   if (n_constraints) {
3904     Mat B;
3905 
3906     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3907     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3908     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3909     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3910     if (n_vertices) {
3911       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3912         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3913       } else {
3914         Mat S_VCt;
3915 
3916         if (lda_rhs != n_R) {
3917           ierr = MatDestroy(&B);CHKERRQ(ierr);
3918           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3919           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3920         }
3921         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3922         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3923         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3924       }
3925     }
3926     ierr = MatDestroy(&B);CHKERRQ(ierr);
3927     /* coarse basis functions */
3928     for (i=0;i<n_constraints;i++) {
3929       PetscScalar *y;
3930 
3931       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3932       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3933       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3934       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3935       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3936       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3937       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3938       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3939         PetscInt j;
3940 
3941         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3942         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3943         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3944         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3945         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3946         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3947         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3948       }
3949       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3950     }
3951   }
3952   if (n_constraints) {
3953     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3954   }
3955   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3956 
3957   /* coarse matrix entries relative to B_0 */
3958   if (pcbddc->benign_n) {
3959     Mat         B0_B,B0_BPHI;
3960     IS          is_dummy;
3961     PetscScalar *data;
3962     PetscInt    j;
3963 
3964     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3965     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3966     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3967     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3968     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3969     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3970     for (j=0;j<pcbddc->benign_n;j++) {
3971       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3972       for (i=0;i<pcbddc->local_primal_size;i++) {
3973         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3974         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3975       }
3976     }
3977     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3978     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3979     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3980   }
3981 
3982   /* compute other basis functions for non-symmetric problems */
3983   if (!pcbddc->symmetric_primal) {
3984     Mat         B_V=NULL,B_C=NULL;
3985     PetscScalar *marray;
3986 
3987     if (n_constraints) {
3988       Mat S_CCT,C_CRT;
3989 
3990       ierr = MatTranspose(C_CR,MAT_INPLACE_MATRIX,&C_CRT);CHKERRQ(ierr);
3991       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3992       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3993       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3994       if (n_vertices) {
3995         Mat S_VCT;
3996 
3997         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3998         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3999         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4000       }
4001       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4002     } else {
4003       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4004     }
4005     if (n_vertices && n_R) {
4006       PetscScalar    *av,*marray;
4007       const PetscInt *xadj,*adjncy;
4008       PetscInt       n;
4009       PetscBool      flg_row;
4010 
4011       /* B_V = B_V - A_VR^T */
4012       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4013       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4014       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4015       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4016       for (i=0;i<n;i++) {
4017         PetscInt j;
4018         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4019       }
4020       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4021       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4022       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4023     }
4024 
4025     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4026     ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4027     for (i=0;i<n_vertices;i++) {
4028       ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4029       ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4030       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4031       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4032       ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4033     }
4034     ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4035     if (B_C) {
4036       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4037       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4038         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4039         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4040         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4041         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4042         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4043       }
4044       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4045     }
4046     /* coarse basis functions */
4047     for (i=0;i<pcbddc->local_primal_size;i++) {
4048       PetscScalar *y;
4049 
4050       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4051       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4052       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4053       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4054       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4055       if (i<n_vertices) {
4056         y[n_B*i+idx_V_B[i]] = 1.0;
4057       }
4058       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4059       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4060 
4061       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4062         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4063         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4064         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4065         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4066         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4067         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4068       }
4069       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4070     }
4071     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4072     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4073   }
4074   /* free memory */
4075   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4076   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4077   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4078   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4079   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4080   ierr = PetscFree(work);CHKERRQ(ierr);
4081   if (n_vertices) {
4082     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4083   }
4084   if (n_constraints) {
4085     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4086   }
4087   /* Checking coarse_sub_mat and coarse basis functios */
4088   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4089   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4090   if (pcbddc->dbg_flag) {
4091     Mat         coarse_sub_mat;
4092     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4093     Mat         coarse_phi_D,coarse_phi_B;
4094     Mat         coarse_psi_D,coarse_psi_B;
4095     Mat         A_II,A_BB,A_IB,A_BI;
4096     Mat         C_B,CPHI;
4097     IS          is_dummy;
4098     Vec         mones;
4099     MatType     checkmattype=MATSEQAIJ;
4100     PetscReal   real_value;
4101 
4102     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4103       Mat A;
4104       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4105       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4106       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4107       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4108       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4109       ierr = MatDestroy(&A);CHKERRQ(ierr);
4110     } else {
4111       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4112       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4113       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4114       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4115     }
4116     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4117     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4118     if (!pcbddc->symmetric_primal) {
4119       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4120       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4121     }
4122     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4123 
4124     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4125     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4126     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4127     if (!pcbddc->symmetric_primal) {
4128       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4129       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4130       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4131       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4132       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4133       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4134       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4135       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4136       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4137       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4138       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4139       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4140     } else {
4141       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4142       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4143       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4144       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4145       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4146       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4147       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4148       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4149     }
4150     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4151     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4152     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4153     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4154     if (pcbddc->benign_n) {
4155       Mat         B0_B,B0_BPHI;
4156       PetscScalar *data,*data2;
4157       PetscInt    j;
4158 
4159       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4160       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4161       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4162       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4163       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4164       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4165       for (j=0;j<pcbddc->benign_n;j++) {
4166         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4167         for (i=0;i<pcbddc->local_primal_size;i++) {
4168           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4169           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4170         }
4171       }
4172       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4173       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4174       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4175       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4176       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4177     }
4178 #if 0
4179   {
4180     PetscViewer viewer;
4181     char filename[256];
4182     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4183     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4184     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4185     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4186     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4187     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4188     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4189     if (save_change) {
4190       Mat phi_B;
4191       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4192       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4193       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4194       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4195     } else {
4196       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4197       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4198     }
4199     if (pcbddc->coarse_phi_D) {
4200       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4201       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4202     }
4203     if (pcbddc->coarse_psi_B) {
4204       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4205       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4206     }
4207     if (pcbddc->coarse_psi_D) {
4208       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4209       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4210     }
4211     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4212   }
4213 #endif
4214     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4215     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4216     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4217     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4218 
4219     /* check constraints */
4220     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4221     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4222     if (!pcbddc->benign_n) { /* TODO: add benign case */
4223       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4224     } else {
4225       PetscScalar *data;
4226       Mat         tmat;
4227       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4228       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4229       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4230       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4231       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4232     }
4233     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4234     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4235     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4236     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4237     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4238     if (!pcbddc->symmetric_primal) {
4239       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4240       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4241       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4242       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4243       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4244     }
4245     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4246     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4247     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4248     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4249     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4250     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4251     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4252     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4253     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4254     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4255     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4256     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4257     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4258     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4259     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4260     if (!pcbddc->symmetric_primal) {
4261       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4262       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4263     }
4264     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4265   }
4266   /* get back data */
4267   *coarse_submat_vals_n = coarse_submat_vals;
4268   PetscFunctionReturn(0);
4269 }
4270 
4271 #undef __FUNCT__
4272 #define __FUNCT__ "MatGetSubMatrixUnsorted"
4273 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4274 {
4275   Mat            *work_mat;
4276   IS             isrow_s,iscol_s;
4277   PetscBool      rsorted,csorted;
4278   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4279   PetscErrorCode ierr;
4280 
4281   PetscFunctionBegin;
4282   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4283   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4284   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4285   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4286 
4287   if (!rsorted) {
4288     const PetscInt *idxs;
4289     PetscInt *idxs_sorted,i;
4290 
4291     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4292     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4293     for (i=0;i<rsize;i++) {
4294       idxs_perm_r[i] = i;
4295     }
4296     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4297     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4298     for (i=0;i<rsize;i++) {
4299       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4300     }
4301     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4302     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4303   } else {
4304     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4305     isrow_s = isrow;
4306   }
4307 
4308   if (!csorted) {
4309     if (isrow == iscol) {
4310       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4311       iscol_s = isrow_s;
4312     } else {
4313       const PetscInt *idxs;
4314       PetscInt       *idxs_sorted,i;
4315 
4316       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4317       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4318       for (i=0;i<csize;i++) {
4319         idxs_perm_c[i] = i;
4320       }
4321       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4322       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4323       for (i=0;i<csize;i++) {
4324         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4325       }
4326       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4327       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4328     }
4329   } else {
4330     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4331     iscol_s = iscol;
4332   }
4333 
4334   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4335 
4336   if (!rsorted || !csorted) {
4337     Mat      new_mat;
4338     IS       is_perm_r,is_perm_c;
4339 
4340     if (!rsorted) {
4341       PetscInt *idxs_r,i;
4342       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4343       for (i=0;i<rsize;i++) {
4344         idxs_r[idxs_perm_r[i]] = i;
4345       }
4346       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4347       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4348     } else {
4349       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4350     }
4351     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4352 
4353     if (!csorted) {
4354       if (isrow_s == iscol_s) {
4355         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4356         is_perm_c = is_perm_r;
4357       } else {
4358         PetscInt *idxs_c,i;
4359         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4360         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4361         for (i=0;i<csize;i++) {
4362           idxs_c[idxs_perm_c[i]] = i;
4363         }
4364         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4365         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4366       }
4367     } else {
4368       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4369     }
4370     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4371 
4372     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4373     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4374     work_mat[0] = new_mat;
4375     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4376     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4377   }
4378 
4379   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4380   *B = work_mat[0];
4381   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4382   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4383   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4384   PetscFunctionReturn(0);
4385 }
4386 
4387 #undef __FUNCT__
4388 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
4389 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4390 {
4391   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4392   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4393   Mat            new_mat;
4394   IS             is_local,is_global;
4395   PetscInt       local_size;
4396   PetscBool      isseqaij;
4397   PetscErrorCode ierr;
4398 
4399   PetscFunctionBegin;
4400   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4401   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4402   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4403   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4404   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4405   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4406   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4407 
4408   /* check */
4409   if (pcbddc->dbg_flag) {
4410     Vec       x,x_change;
4411     PetscReal error;
4412 
4413     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4414     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4415     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4416     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4417     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4418     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4419     if (!pcbddc->change_interior) {
4420       const PetscScalar *x,*y,*v;
4421       PetscReal         lerror = 0.;
4422       PetscInt          i;
4423 
4424       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4425       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4426       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4427       for (i=0;i<local_size;i++)
4428         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4429           lerror = PetscAbsScalar(x[i]-y[i]);
4430       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4431       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4432       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4433       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4434       if (error > PETSC_SMALL) {
4435         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4436           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4437         } else {
4438           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4439         }
4440       }
4441     }
4442     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4443     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4444     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4445     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4446     if (error > PETSC_SMALL) {
4447       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4448         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4449       } else {
4450         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4451       }
4452     }
4453     ierr = VecDestroy(&x);CHKERRQ(ierr);
4454     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4455   }
4456 
4457   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4458   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4459   if (isseqaij) {
4460     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4461     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4462   } else {
4463     Mat work_mat;
4464 
4465     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4466     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4467     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4468     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4469   }
4470   if (matis->A->symmetric_set) {
4471     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4472 #if !defined(PETSC_USE_COMPLEX)
4473     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4474 #endif
4475   }
4476   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4477   PetscFunctionReturn(0);
4478 }
4479 
4480 #undef __FUNCT__
4481 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4482 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4483 {
4484   PC_IS*          pcis = (PC_IS*)(pc->data);
4485   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4486   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4487   PetscInt        *idx_R_local=NULL;
4488   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4489   PetscInt        vbs,bs;
4490   PetscBT         bitmask=NULL;
4491   PetscErrorCode  ierr;
4492 
4493   PetscFunctionBegin;
4494   /*
4495     No need to setup local scatters if
4496       - primal space is unchanged
4497         AND
4498       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4499         AND
4500       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4501   */
4502   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4503     PetscFunctionReturn(0);
4504   }
4505   /* destroy old objects */
4506   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4507   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4508   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4509   /* Set Non-overlapping dimensions */
4510   n_B = pcis->n_B;
4511   n_D = pcis->n - n_B;
4512   n_vertices = pcbddc->n_vertices;
4513 
4514   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4515 
4516   /* create auxiliary bitmask and allocate workspace */
4517   if (!sub_schurs || !sub_schurs->reuse_solver) {
4518     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4519     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4520     for (i=0;i<n_vertices;i++) {
4521       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4522     }
4523 
4524     for (i=0, n_R=0; i<pcis->n; i++) {
4525       if (!PetscBTLookup(bitmask,i)) {
4526         idx_R_local[n_R++] = i;
4527       }
4528     }
4529   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4530     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4531 
4532     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4533     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4534   }
4535 
4536   /* Block code */
4537   vbs = 1;
4538   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4539   if (bs>1 && !(n_vertices%bs)) {
4540     PetscBool is_blocked = PETSC_TRUE;
4541     PetscInt  *vary;
4542     if (!sub_schurs || !sub_schurs->reuse_solver) {
4543       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4544       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4545       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4546       /* 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 */
4547       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4548       for (i=0; i<pcis->n/bs; i++) {
4549         if (vary[i]!=0 && vary[i]!=bs) {
4550           is_blocked = PETSC_FALSE;
4551           break;
4552         }
4553       }
4554       ierr = PetscFree(vary);CHKERRQ(ierr);
4555     } else {
4556       /* Verify directly the R set */
4557       for (i=0; i<n_R/bs; i++) {
4558         PetscInt j,node=idx_R_local[bs*i];
4559         for (j=1; j<bs; j++) {
4560           if (node != idx_R_local[bs*i+j]-j) {
4561             is_blocked = PETSC_FALSE;
4562             break;
4563           }
4564         }
4565       }
4566     }
4567     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4568       vbs = bs;
4569       for (i=0;i<n_R/vbs;i++) {
4570         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4571       }
4572     }
4573   }
4574   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4575   if (sub_schurs && sub_schurs->reuse_solver) {
4576     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4577 
4578     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4579     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4580     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4581     reuse_solver->is_R = pcbddc->is_R_local;
4582   } else {
4583     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4584   }
4585 
4586   /* print some info if requested */
4587   if (pcbddc->dbg_flag) {
4588     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4589     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4590     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4591     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4592     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4593     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);
4594     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4595   }
4596 
4597   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4598   if (!sub_schurs || !sub_schurs->reuse_solver) {
4599     IS       is_aux1,is_aux2;
4600     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4601 
4602     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4603     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4604     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4605     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4606     for (i=0; i<n_D; i++) {
4607       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4608     }
4609     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4610     for (i=0, j=0; i<n_R; i++) {
4611       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4612         aux_array1[j++] = i;
4613       }
4614     }
4615     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4616     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4617     for (i=0, j=0; i<n_B; i++) {
4618       if (!PetscBTLookup(bitmask,is_indices[i])) {
4619         aux_array2[j++] = i;
4620       }
4621     }
4622     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4623     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4624     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4625     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4626     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4627 
4628     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4629       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4630       for (i=0, j=0; i<n_R; i++) {
4631         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4632           aux_array1[j++] = i;
4633         }
4634       }
4635       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4636       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4637       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4638     }
4639     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4640     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4641   } else {
4642     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4643     IS                 tis;
4644     PetscInt           schur_size;
4645 
4646     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4647     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4648     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4649     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4650     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4651       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4652       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4653       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4654     }
4655   }
4656   PetscFunctionReturn(0);
4657 }
4658 
4659 
4660 #undef __FUNCT__
4661 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4662 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4663 {
4664   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4665   PC_IS          *pcis = (PC_IS*)pc->data;
4666   PC             pc_temp;
4667   Mat            A_RR;
4668   MatReuse       reuse;
4669   PetscScalar    m_one = -1.0;
4670   PetscReal      value;
4671   PetscInt       n_D,n_R;
4672   PetscBool      check_corr[2],issbaij;
4673   PetscErrorCode ierr;
4674   /* prefixes stuff */
4675   char           dir_prefix[256],neu_prefix[256],str_level[16];
4676   size_t         len;
4677 
4678   PetscFunctionBegin;
4679 
4680   /* compute prefixes */
4681   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4682   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4683   if (!pcbddc->current_level) {
4684     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4685     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4686     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4687     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4688   } else {
4689     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4690     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4691     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4692     len -= 15; /* remove "pc_bddc_coarse_" */
4693     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4694     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4695     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4696     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4697     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4698     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4699     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4700     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4701   }
4702 
4703   /* DIRICHLET PROBLEM */
4704   if (dirichlet) {
4705     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4706     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4707       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4708       if (pcbddc->dbg_flag) {
4709         Mat    A_IIn;
4710 
4711         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4712         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4713         pcis->A_II = A_IIn;
4714       }
4715     }
4716     if (pcbddc->local_mat->symmetric_set) {
4717       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4718     }
4719     /* Matrix for Dirichlet problem is pcis->A_II */
4720     n_D = pcis->n - pcis->n_B;
4721     if (!pcbddc->ksp_D) { /* create object if not yet build */
4722       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4723       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4724       /* default */
4725       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4726       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4727       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4728       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4729       if (issbaij) {
4730         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4731       } else {
4732         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4733       }
4734       /* Allow user's customization */
4735       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4736       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4737     }
4738     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4739     if (sub_schurs && sub_schurs->reuse_solver) {
4740       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4741 
4742       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4743     }
4744     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4745     if (!n_D) {
4746       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4747       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4748     }
4749     /* Set Up KSP for Dirichlet problem of BDDC */
4750     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4751     /* set ksp_D into pcis data */
4752     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4753     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4754     pcis->ksp_D = pcbddc->ksp_D;
4755   }
4756 
4757   /* NEUMANN PROBLEM */
4758   A_RR = 0;
4759   if (neumann) {
4760     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4761     PetscInt        ibs,mbs;
4762     PetscBool       issbaij;
4763     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4764     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4765     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4766     if (pcbddc->ksp_R) { /* already created ksp */
4767       PetscInt nn_R;
4768       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4769       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4770       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4771       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4772         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4773         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4774         reuse = MAT_INITIAL_MATRIX;
4775       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4776         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4777           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4778           reuse = MAT_INITIAL_MATRIX;
4779         } else { /* safe to reuse the matrix */
4780           reuse = MAT_REUSE_MATRIX;
4781         }
4782       }
4783       /* last check */
4784       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4785         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4786         reuse = MAT_INITIAL_MATRIX;
4787       }
4788     } else { /* first time, so we need to create the matrix */
4789       reuse = MAT_INITIAL_MATRIX;
4790     }
4791     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4792     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4793     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4794     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4795     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4796       if (matis->A == pcbddc->local_mat) {
4797         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4798         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4799       } else {
4800         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4801       }
4802     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4803       if (matis->A == pcbddc->local_mat) {
4804         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4805         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4806       } else {
4807         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4808       }
4809     }
4810     /* extract A_RR */
4811     if (sub_schurs && sub_schurs->reuse_solver) {
4812       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4813 
4814       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4815         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4816         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4817           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4818         } else {
4819           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4820         }
4821       } else {
4822         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4823         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4824         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4825       }
4826     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4827       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4828     }
4829     if (pcbddc->local_mat->symmetric_set) {
4830       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4831     }
4832     if (!pcbddc->ksp_R) { /* create object if not present */
4833       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4834       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4835       /* default */
4836       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4837       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4838       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4839       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4840       if (issbaij) {
4841         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4842       } else {
4843         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4844       }
4845       /* Allow user's customization */
4846       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4847       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4848     }
4849     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4850     if (!n_R) {
4851       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4852       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4853     }
4854     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4855     /* Reuse solver if it is present */
4856     if (sub_schurs && sub_schurs->reuse_solver) {
4857       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4858 
4859       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4860     }
4861     /* Set Up KSP for Neumann problem of BDDC */
4862     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4863   }
4864 
4865   if (pcbddc->dbg_flag) {
4866     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4867     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4868     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4869   }
4870 
4871   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4872   check_corr[0] = check_corr[1] = PETSC_FALSE;
4873   if (pcbddc->NullSpace_corr[0]) {
4874     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4875   }
4876   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4877     check_corr[0] = PETSC_TRUE;
4878     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4879   }
4880   if (neumann && pcbddc->NullSpace_corr[2]) {
4881     check_corr[1] = PETSC_TRUE;
4882     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4883   }
4884 
4885   /* check Dirichlet and Neumann solvers */
4886   if (pcbddc->dbg_flag) {
4887     if (dirichlet) { /* Dirichlet */
4888       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4889       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4890       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4891       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4892       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4893       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);
4894       if (check_corr[0]) {
4895         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4896       }
4897       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4898     }
4899     if (neumann) { /* Neumann */
4900       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4901       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4902       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4903       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4904       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4905       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);
4906       if (check_corr[1]) {
4907         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4908       }
4909       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4910     }
4911   }
4912   /* free Neumann problem's matrix */
4913   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4914   PetscFunctionReturn(0);
4915 }
4916 
4917 #undef __FUNCT__
4918 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4919 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4920 {
4921   PetscErrorCode  ierr;
4922   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4923   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4924   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4925 
4926   PetscFunctionBegin;
4927   if (!reuse_solver) {
4928     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4929   }
4930   if (!pcbddc->switch_static) {
4931     if (applytranspose && pcbddc->local_auxmat1) {
4932       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4933       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4934     }
4935     if (!reuse_solver) {
4936       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4937       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4938     } else {
4939       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4940 
4941       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4942       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4943     }
4944   } else {
4945     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4946     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4947     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4948     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4949     if (applytranspose && pcbddc->local_auxmat1) {
4950       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4951       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4952       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4953       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4954     }
4955   }
4956   if (!reuse_solver || pcbddc->switch_static) {
4957     if (applytranspose) {
4958       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4959     } else {
4960       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4961     }
4962   } else {
4963     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4964 
4965     if (applytranspose) {
4966       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4967     } else {
4968       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4969     }
4970   }
4971   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4972   if (!pcbddc->switch_static) {
4973     if (!reuse_solver) {
4974       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4975       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4976     } else {
4977       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4978 
4979       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4980       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4981     }
4982     if (!applytranspose && pcbddc->local_auxmat1) {
4983       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4984       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4985     }
4986   } else {
4987     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4988     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4989     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4990     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4991     if (!applytranspose && pcbddc->local_auxmat1) {
4992       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4993       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4994     }
4995     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4996     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4997     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4998     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4999   }
5000   PetscFunctionReturn(0);
5001 }
5002 
5003 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5004 #undef __FUNCT__
5005 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
5006 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5007 {
5008   PetscErrorCode ierr;
5009   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5010   PC_IS*            pcis = (PC_IS*)  (pc->data);
5011   const PetscScalar zero = 0.0;
5012 
5013   PetscFunctionBegin;
5014   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5015   if (!pcbddc->benign_apply_coarse_only) {
5016     if (applytranspose) {
5017       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5018       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5019     } else {
5020       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5021       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5022     }
5023   } else {
5024     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5025   }
5026 
5027   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5028   if (pcbddc->benign_n) {
5029     PetscScalar *array;
5030     PetscInt    j;
5031 
5032     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5033     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5034     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5035   }
5036 
5037   /* start communications from local primal nodes to rhs of coarse solver */
5038   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5039   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5040   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5041 
5042   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5043   if (pcbddc->coarse_ksp) {
5044     Mat          coarse_mat;
5045     Vec          rhs,sol;
5046     MatNullSpace nullsp;
5047     PetscBool    isbddc = PETSC_FALSE;
5048 
5049     if (pcbddc->benign_have_null) {
5050       PC        coarse_pc;
5051 
5052       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5053       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5054       /* we need to propagate to coarser levels the need for a possible benign correction */
5055       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5056         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5057         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5058         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5059       }
5060     }
5061     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5062     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5063     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5064     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5065     if (nullsp) {
5066       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5067     }
5068     if (applytranspose) {
5069       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5070       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5071     } else {
5072       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5073         PC        coarse_pc;
5074 
5075         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5076         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5077         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5078         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5079       } else {
5080         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5081       }
5082     }
5083     /* we don't need the benign correction at coarser levels anymore */
5084     if (pcbddc->benign_have_null && isbddc) {
5085       PC        coarse_pc;
5086       PC_BDDC*  coarsepcbddc;
5087 
5088       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5089       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5090       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5091       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5092     }
5093     if (nullsp) {
5094       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5095     }
5096   }
5097 
5098   /* Local solution on R nodes */
5099   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5100     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5101   }
5102   /* communications from coarse sol to local primal nodes */
5103   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5104   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5105 
5106   /* Sum contributions from the two levels */
5107   if (!pcbddc->benign_apply_coarse_only) {
5108     if (applytranspose) {
5109       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5110       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5111     } else {
5112       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5113       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5114     }
5115     /* store p0 */
5116     if (pcbddc->benign_n) {
5117       PetscScalar *array;
5118       PetscInt    j;
5119 
5120       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5121       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5122       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5123     }
5124   } else { /* expand the coarse solution */
5125     if (applytranspose) {
5126       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5127     } else {
5128       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5129     }
5130   }
5131   PetscFunctionReturn(0);
5132 }
5133 
5134 #undef __FUNCT__
5135 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5136 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5137 {
5138   PetscErrorCode ierr;
5139   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5140   PetscScalar    *array;
5141   Vec            from,to;
5142 
5143   PetscFunctionBegin;
5144   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5145     from = pcbddc->coarse_vec;
5146     to = pcbddc->vec1_P;
5147     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5148       Vec tvec;
5149 
5150       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5151       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5152       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5153       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5154       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5155       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5156     }
5157   } else { /* from local to global -> put data in coarse right hand side */
5158     from = pcbddc->vec1_P;
5159     to = pcbddc->coarse_vec;
5160   }
5161   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5162   PetscFunctionReturn(0);
5163 }
5164 
5165 #undef __FUNCT__
5166 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5167 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5168 {
5169   PetscErrorCode ierr;
5170   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5171   PetscScalar    *array;
5172   Vec            from,to;
5173 
5174   PetscFunctionBegin;
5175   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5176     from = pcbddc->coarse_vec;
5177     to = pcbddc->vec1_P;
5178   } else { /* from local to global -> put data in coarse right hand side */
5179     from = pcbddc->vec1_P;
5180     to = pcbddc->coarse_vec;
5181   }
5182   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5183   if (smode == SCATTER_FORWARD) {
5184     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5185       Vec tvec;
5186 
5187       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5188       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5189       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5190       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5191     }
5192   } else {
5193     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5194      ierr = VecResetArray(from);CHKERRQ(ierr);
5195     }
5196   }
5197   PetscFunctionReturn(0);
5198 }
5199 
5200 /* uncomment for testing purposes */
5201 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5202 #undef __FUNCT__
5203 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5204 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5205 {
5206   PetscErrorCode    ierr;
5207   PC_IS*            pcis = (PC_IS*)(pc->data);
5208   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5209   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5210   /* one and zero */
5211   PetscScalar       one=1.0,zero=0.0;
5212   /* space to store constraints and their local indices */
5213   PetscScalar       *constraints_data;
5214   PetscInt          *constraints_idxs,*constraints_idxs_B;
5215   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5216   PetscInt          *constraints_n;
5217   /* iterators */
5218   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5219   /* BLAS integers */
5220   PetscBLASInt      lwork,lierr;
5221   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5222   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5223   /* reuse */
5224   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5225   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5226   /* change of basis */
5227   PetscBool         qr_needed;
5228   PetscBT           change_basis,qr_needed_idx;
5229   /* auxiliary stuff */
5230   PetscInt          *nnz,*is_indices;
5231   PetscInt          ncc;
5232   /* some quantities */
5233   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5234   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5235 
5236   PetscFunctionBegin;
5237   /* Destroy Mat objects computed previously */
5238   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5239   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5240   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5241   /* save info on constraints from previous setup (if any) */
5242   olocal_primal_size = pcbddc->local_primal_size;
5243   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5244   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5245   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5246   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5247   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5248   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5249 
5250   if (!pcbddc->adaptive_selection) {
5251     IS           ISForVertices,*ISForFaces,*ISForEdges;
5252     MatNullSpace nearnullsp;
5253     const Vec    *nearnullvecs;
5254     Vec          *localnearnullsp;
5255     PetscScalar  *array;
5256     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5257     PetscBool    nnsp_has_cnst;
5258     /* LAPACK working arrays for SVD or POD */
5259     PetscBool    skip_lapack,boolforchange;
5260     PetscScalar  *work;
5261     PetscReal    *singular_vals;
5262 #if defined(PETSC_USE_COMPLEX)
5263     PetscReal    *rwork;
5264 #endif
5265 #if defined(PETSC_MISSING_LAPACK_GESVD)
5266     PetscScalar  *temp_basis,*correlation_mat;
5267 #else
5268     PetscBLASInt dummy_int=1;
5269     PetscScalar  dummy_scalar=1.;
5270 #endif
5271 
5272     /* Get index sets for faces, edges and vertices from graph */
5273     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5274     /* print some info */
5275     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5276       PetscInt nv;
5277 
5278       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5279       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5280       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5281       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5282       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5283       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5284       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5285       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5286       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5287     }
5288 
5289     /* free unneeded index sets */
5290     if (!pcbddc->use_vertices) {
5291       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5292     }
5293     if (!pcbddc->use_edges) {
5294       for (i=0;i<n_ISForEdges;i++) {
5295         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5296       }
5297       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5298       n_ISForEdges = 0;
5299     }
5300     if (!pcbddc->use_faces) {
5301       for (i=0;i<n_ISForFaces;i++) {
5302         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5303       }
5304       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5305       n_ISForFaces = 0;
5306     }
5307 
5308     /* check if near null space is attached to global mat */
5309     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5310     if (nearnullsp) {
5311       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5312       /* remove any stored info */
5313       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5314       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5315       /* store information for BDDC solver reuse */
5316       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5317       pcbddc->onearnullspace = nearnullsp;
5318       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5319       for (i=0;i<nnsp_size;i++) {
5320         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5321       }
5322     } else { /* if near null space is not provided BDDC uses constants by default */
5323       nnsp_size = 0;
5324       nnsp_has_cnst = PETSC_TRUE;
5325     }
5326     /* get max number of constraints on a single cc */
5327     max_constraints = nnsp_size;
5328     if (nnsp_has_cnst) max_constraints++;
5329 
5330     /*
5331          Evaluate maximum storage size needed by the procedure
5332          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5333          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5334          There can be multiple constraints per connected component
5335                                                                                                                                                            */
5336     n_vertices = 0;
5337     if (ISForVertices) {
5338       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5339     }
5340     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5341     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5342 
5343     total_counts = n_ISForFaces+n_ISForEdges;
5344     total_counts *= max_constraints;
5345     total_counts += n_vertices;
5346     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5347 
5348     total_counts = 0;
5349     max_size_of_constraint = 0;
5350     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5351       IS used_is;
5352       if (i<n_ISForEdges) {
5353         used_is = ISForEdges[i];
5354       } else {
5355         used_is = ISForFaces[i-n_ISForEdges];
5356       }
5357       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5358       total_counts += j;
5359       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5360     }
5361     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);
5362 
5363     /* get local part of global near null space vectors */
5364     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5365     for (k=0;k<nnsp_size;k++) {
5366       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5367       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5368       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5369     }
5370 
5371     /* whether or not to skip lapack calls */
5372     skip_lapack = PETSC_TRUE;
5373     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5374 
5375     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5376     if (!skip_lapack) {
5377       PetscScalar temp_work;
5378 
5379 #if defined(PETSC_MISSING_LAPACK_GESVD)
5380       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5381       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5382       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5383       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5384 #if defined(PETSC_USE_COMPLEX)
5385       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5386 #endif
5387       /* now we evaluate the optimal workspace using query with lwork=-1 */
5388       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5389       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5390       lwork = -1;
5391       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5392 #if !defined(PETSC_USE_COMPLEX)
5393       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5394 #else
5395       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5396 #endif
5397       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5398       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5399 #else /* on missing GESVD */
5400       /* SVD */
5401       PetscInt max_n,min_n;
5402       max_n = max_size_of_constraint;
5403       min_n = max_constraints;
5404       if (max_size_of_constraint < max_constraints) {
5405         min_n = max_size_of_constraint;
5406         max_n = max_constraints;
5407       }
5408       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5409 #if defined(PETSC_USE_COMPLEX)
5410       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5411 #endif
5412       /* now we evaluate the optimal workspace using query with lwork=-1 */
5413       lwork = -1;
5414       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5415       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5416       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5417       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5418 #if !defined(PETSC_USE_COMPLEX)
5419       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));
5420 #else
5421       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));
5422 #endif
5423       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5424       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5425 #endif /* on missing GESVD */
5426       /* Allocate optimal workspace */
5427       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5428       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5429     }
5430     /* Now we can loop on constraining sets */
5431     total_counts = 0;
5432     constraints_idxs_ptr[0] = 0;
5433     constraints_data_ptr[0] = 0;
5434     /* vertices */
5435     if (n_vertices) {
5436       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5437       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5438       for (i=0;i<n_vertices;i++) {
5439         constraints_n[total_counts] = 1;
5440         constraints_data[total_counts] = 1.0;
5441         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5442         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5443         total_counts++;
5444       }
5445       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5446       n_vertices = total_counts;
5447     }
5448 
5449     /* edges and faces */
5450     total_counts_cc = total_counts;
5451     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5452       IS        used_is;
5453       PetscBool idxs_copied = PETSC_FALSE;
5454 
5455       if (ncc<n_ISForEdges) {
5456         used_is = ISForEdges[ncc];
5457         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5458       } else {
5459         used_is = ISForFaces[ncc-n_ISForEdges];
5460         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5461       }
5462       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5463 
5464       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5465       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5466       /* change of basis should not be performed on local periodic nodes */
5467       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5468       if (nnsp_has_cnst) {
5469         PetscScalar quad_value;
5470 
5471         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5472         idxs_copied = PETSC_TRUE;
5473 
5474         if (!pcbddc->use_nnsp_true) {
5475           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5476         } else {
5477           quad_value = 1.0;
5478         }
5479         for (j=0;j<size_of_constraint;j++) {
5480           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5481         }
5482         temp_constraints++;
5483         total_counts++;
5484       }
5485       for (k=0;k<nnsp_size;k++) {
5486         PetscReal real_value;
5487         PetscScalar *ptr_to_data;
5488 
5489         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5490         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5491         for (j=0;j<size_of_constraint;j++) {
5492           ptr_to_data[j] = array[is_indices[j]];
5493         }
5494         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5495         /* check if array is null on the connected component */
5496         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5497         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5498         if (real_value > 0.0) { /* keep indices and values */
5499           temp_constraints++;
5500           total_counts++;
5501           if (!idxs_copied) {
5502             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5503             idxs_copied = PETSC_TRUE;
5504           }
5505         }
5506       }
5507       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5508       valid_constraints = temp_constraints;
5509       if (!pcbddc->use_nnsp_true && temp_constraints) {
5510         if (temp_constraints == 1) { /* just normalize the constraint */
5511           PetscScalar norm,*ptr_to_data;
5512 
5513           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5514           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5515           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5516           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5517           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5518         } else { /* perform SVD */
5519           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5520           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5521 
5522 #if defined(PETSC_MISSING_LAPACK_GESVD)
5523           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5524              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5525              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5526                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5527                 from that computed using LAPACKgesvd
5528              -> This is due to a different computation of eigenvectors in LAPACKheev
5529              -> The quality of the POD-computed basis will be the same */
5530           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5531           /* Store upper triangular part of correlation matrix */
5532           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5533           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5534           for (j=0;j<temp_constraints;j++) {
5535             for (k=0;k<j+1;k++) {
5536               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));
5537             }
5538           }
5539           /* compute eigenvalues and eigenvectors of correlation matrix */
5540           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5541           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5542 #if !defined(PETSC_USE_COMPLEX)
5543           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5544 #else
5545           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5546 #endif
5547           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5548           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5549           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5550           j = 0;
5551           while (j < temp_constraints && singular_vals[j] < tol) j++;
5552           total_counts = total_counts-j;
5553           valid_constraints = temp_constraints-j;
5554           /* scale and copy POD basis into used quadrature memory */
5555           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5556           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5557           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5558           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5559           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5560           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5561           if (j<temp_constraints) {
5562             PetscInt ii;
5563             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5564             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5565             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));
5566             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5567             for (k=0;k<temp_constraints-j;k++) {
5568               for (ii=0;ii<size_of_constraint;ii++) {
5569                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5570               }
5571             }
5572           }
5573 #else  /* on missing GESVD */
5574           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5575           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5576           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5577           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5578 #if !defined(PETSC_USE_COMPLEX)
5579           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));
5580 #else
5581           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));
5582 #endif
5583           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5584           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5585           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5586           k = temp_constraints;
5587           if (k > size_of_constraint) k = size_of_constraint;
5588           j = 0;
5589           while (j < k && singular_vals[k-j-1] < tol) j++;
5590           valid_constraints = k-j;
5591           total_counts = total_counts-temp_constraints+valid_constraints;
5592 #endif /* on missing GESVD */
5593         }
5594       }
5595       /* update pointers information */
5596       if (valid_constraints) {
5597         constraints_n[total_counts_cc] = valid_constraints;
5598         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5599         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5600         /* set change_of_basis flag */
5601         if (boolforchange) {
5602           PetscBTSet(change_basis,total_counts_cc);
5603         }
5604         total_counts_cc++;
5605       }
5606     }
5607     /* free workspace */
5608     if (!skip_lapack) {
5609       ierr = PetscFree(work);CHKERRQ(ierr);
5610 #if defined(PETSC_USE_COMPLEX)
5611       ierr = PetscFree(rwork);CHKERRQ(ierr);
5612 #endif
5613       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5614 #if defined(PETSC_MISSING_LAPACK_GESVD)
5615       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5616       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5617 #endif
5618     }
5619     for (k=0;k<nnsp_size;k++) {
5620       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5621     }
5622     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5623     /* free index sets of faces, edges and vertices */
5624     for (i=0;i<n_ISForFaces;i++) {
5625       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5626     }
5627     if (n_ISForFaces) {
5628       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5629     }
5630     for (i=0;i<n_ISForEdges;i++) {
5631       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5632     }
5633     if (n_ISForEdges) {
5634       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5635     }
5636     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5637   } else {
5638     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5639 
5640     total_counts = 0;
5641     n_vertices = 0;
5642     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5643       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5644     }
5645     max_constraints = 0;
5646     total_counts_cc = 0;
5647     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5648       total_counts += pcbddc->adaptive_constraints_n[i];
5649       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5650       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5651     }
5652     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5653     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5654     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5655     constraints_data = pcbddc->adaptive_constraints_data;
5656     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5657     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5658     total_counts_cc = 0;
5659     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5660       if (pcbddc->adaptive_constraints_n[i]) {
5661         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5662       }
5663     }
5664 #if 0
5665     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5666     for (i=0;i<total_counts_cc;i++) {
5667       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5668       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5669       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5670         printf(" %d",constraints_idxs[j]);
5671       }
5672       printf("\n");
5673       printf("number of cc: %d\n",constraints_n[i]);
5674     }
5675     for (i=0;i<n_vertices;i++) {
5676       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5677     }
5678     for (i=0;i<sub_schurs->n_subs;i++) {
5679       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]);
5680     }
5681 #endif
5682 
5683     max_size_of_constraint = 0;
5684     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]);
5685     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5686     /* Change of basis */
5687     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5688     if (pcbddc->use_change_of_basis) {
5689       for (i=0;i<sub_schurs->n_subs;i++) {
5690         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5691           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5692         }
5693       }
5694     }
5695   }
5696   pcbddc->local_primal_size = total_counts;
5697   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5698 
5699   /* map constraints_idxs in boundary numbering */
5700   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5701   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);
5702 
5703   /* Create constraint matrix */
5704   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5705   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5706   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5707 
5708   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5709   /* determine if a QR strategy is needed for change of basis */
5710   qr_needed = PETSC_FALSE;
5711   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5712   total_primal_vertices=0;
5713   pcbddc->local_primal_size_cc = 0;
5714   for (i=0;i<total_counts_cc;i++) {
5715     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5716     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5717       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5718       pcbddc->local_primal_size_cc += 1;
5719     } else if (PetscBTLookup(change_basis,i)) {
5720       for (k=0;k<constraints_n[i];k++) {
5721         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5722       }
5723       pcbddc->local_primal_size_cc += constraints_n[i];
5724       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5725         PetscBTSet(qr_needed_idx,i);
5726         qr_needed = PETSC_TRUE;
5727       }
5728     } else {
5729       pcbddc->local_primal_size_cc += 1;
5730     }
5731   }
5732   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5733   pcbddc->n_vertices = total_primal_vertices;
5734   /* permute indices in order to have a sorted set of vertices */
5735   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5736   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);
5737   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5738   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5739 
5740   /* nonzero structure of constraint matrix */
5741   /* and get reference dof for local constraints */
5742   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5743   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5744 
5745   j = total_primal_vertices;
5746   total_counts = total_primal_vertices;
5747   cum = total_primal_vertices;
5748   for (i=n_vertices;i<total_counts_cc;i++) {
5749     if (!PetscBTLookup(change_basis,i)) {
5750       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5751       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5752       cum++;
5753       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5754       for (k=0;k<constraints_n[i];k++) {
5755         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5756         nnz[j+k] = size_of_constraint;
5757       }
5758       j += constraints_n[i];
5759     }
5760   }
5761   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5762   ierr = PetscFree(nnz);CHKERRQ(ierr);
5763 
5764   /* set values in constraint matrix */
5765   for (i=0;i<total_primal_vertices;i++) {
5766     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5767   }
5768   total_counts = total_primal_vertices;
5769   for (i=n_vertices;i<total_counts_cc;i++) {
5770     if (!PetscBTLookup(change_basis,i)) {
5771       PetscInt *cols;
5772 
5773       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5774       cols = constraints_idxs+constraints_idxs_ptr[i];
5775       for (k=0;k<constraints_n[i];k++) {
5776         PetscInt    row = total_counts+k;
5777         PetscScalar *vals;
5778 
5779         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5780         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5781       }
5782       total_counts += constraints_n[i];
5783     }
5784   }
5785   /* assembling */
5786   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5787   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5788 
5789   /*
5790   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5791   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5792   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5793   */
5794   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5795   if (pcbddc->use_change_of_basis) {
5796     /* dual and primal dofs on a single cc */
5797     PetscInt     dual_dofs,primal_dofs;
5798     /* working stuff for GEQRF */
5799     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5800     PetscBLASInt lqr_work;
5801     /* working stuff for UNGQR */
5802     PetscScalar  *gqr_work,lgqr_work_t;
5803     PetscBLASInt lgqr_work;
5804     /* working stuff for TRTRS */
5805     PetscScalar  *trs_rhs;
5806     PetscBLASInt Blas_NRHS;
5807     /* pointers for values insertion into change of basis matrix */
5808     PetscInt     *start_rows,*start_cols;
5809     PetscScalar  *start_vals;
5810     /* working stuff for values insertion */
5811     PetscBT      is_primal;
5812     PetscInt     *aux_primal_numbering_B;
5813     /* matrix sizes */
5814     PetscInt     global_size,local_size;
5815     /* temporary change of basis */
5816     Mat          localChangeOfBasisMatrix;
5817     /* extra space for debugging */
5818     PetscScalar  *dbg_work;
5819 
5820     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5821     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5822     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5823     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5824     /* nonzeros for local mat */
5825     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5826     if (!pcbddc->benign_change || pcbddc->fake_change) {
5827       for (i=0;i<pcis->n;i++) nnz[i]=1;
5828     } else {
5829       const PetscInt *ii;
5830       PetscInt       n;
5831       PetscBool      flg_row;
5832       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5833       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5834       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5835     }
5836     for (i=n_vertices;i<total_counts_cc;i++) {
5837       if (PetscBTLookup(change_basis,i)) {
5838         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5839         if (PetscBTLookup(qr_needed_idx,i)) {
5840           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5841         } else {
5842           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5843           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5844         }
5845       }
5846     }
5847     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5848     ierr = PetscFree(nnz);CHKERRQ(ierr);
5849     /* Set interior change in the matrix */
5850     if (!pcbddc->benign_change || pcbddc->fake_change) {
5851       for (i=0;i<pcis->n;i++) {
5852         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5853       }
5854     } else {
5855       const PetscInt *ii,*jj;
5856       PetscScalar    *aa;
5857       PetscInt       n;
5858       PetscBool      flg_row;
5859       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5860       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5861       for (i=0;i<n;i++) {
5862         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5863       }
5864       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5865       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5866     }
5867 
5868     if (pcbddc->dbg_flag) {
5869       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5870       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5871     }
5872 
5873 
5874     /* Now we loop on the constraints which need a change of basis */
5875     /*
5876        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5877        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5878 
5879        Basic blocks of change of basis matrix T computed by
5880 
5881           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5882 
5883             | 1        0   ...        0         s_1/S |
5884             | 0        1   ...        0         s_2/S |
5885             |              ...                        |
5886             | 0        ...            1     s_{n-1}/S |
5887             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5888 
5889             with S = \sum_{i=1}^n s_i^2
5890             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5891                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5892 
5893           - QR decomposition of constraints otherwise
5894     */
5895     if (qr_needed) {
5896       /* space to store Q */
5897       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5898       /* array to store scaling factors for reflectors */
5899       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5900       /* first we issue queries for optimal work */
5901       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5902       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5903       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5904       lqr_work = -1;
5905       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5906       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5907       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5908       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5909       lgqr_work = -1;
5910       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5911       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5912       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5913       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5914       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5915       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5916       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5917       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5918       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5919       /* array to store rhs and solution of triangular solver */
5920       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5921       /* allocating workspace for check */
5922       if (pcbddc->dbg_flag) {
5923         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5924       }
5925     }
5926     /* array to store whether a node is primal or not */
5927     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5928     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5929     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5930     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);
5931     for (i=0;i<total_primal_vertices;i++) {
5932       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5933     }
5934     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5935 
5936     /* loop on constraints and see whether or not they need a change of basis and compute it */
5937     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5938       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5939       if (PetscBTLookup(change_basis,total_counts)) {
5940         /* get constraint info */
5941         primal_dofs = constraints_n[total_counts];
5942         dual_dofs = size_of_constraint-primal_dofs;
5943 
5944         if (pcbddc->dbg_flag) {
5945           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);
5946         }
5947 
5948         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5949 
5950           /* copy quadrature constraints for change of basis check */
5951           if (pcbddc->dbg_flag) {
5952             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5953           }
5954           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5955           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5956 
5957           /* compute QR decomposition of constraints */
5958           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5959           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5960           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5961           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5962           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5963           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5964           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5965 
5966           /* explictly compute R^-T */
5967           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5968           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5969           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5970           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5971           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5972           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5973           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5974           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5975           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5976           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5977 
5978           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5979           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5980           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5981           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5982           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5983           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5984           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5985           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5986           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5987 
5988           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5989              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5990              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5991           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5992           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5993           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5994           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5995           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5996           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5997           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5998           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));
5999           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6000           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6001 
6002           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6003           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6004           /* insert cols for primal dofs */
6005           for (j=0;j<primal_dofs;j++) {
6006             start_vals = &qr_basis[j*size_of_constraint];
6007             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6008             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6009           }
6010           /* insert cols for dual dofs */
6011           for (j=0,k=0;j<dual_dofs;k++) {
6012             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6013               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6014               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6015               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6016               j++;
6017             }
6018           }
6019 
6020           /* check change of basis */
6021           if (pcbddc->dbg_flag) {
6022             PetscInt   ii,jj;
6023             PetscBool valid_qr=PETSC_TRUE;
6024             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6025             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6026             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6027             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6028             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6029             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6030             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6031             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));
6032             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6033             for (jj=0;jj<size_of_constraint;jj++) {
6034               for (ii=0;ii<primal_dofs;ii++) {
6035                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6036                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6037               }
6038             }
6039             if (!valid_qr) {
6040               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6041               for (jj=0;jj<size_of_constraint;jj++) {
6042                 for (ii=0;ii<primal_dofs;ii++) {
6043                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6044                     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]));
6045                   }
6046                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6047                     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]));
6048                   }
6049                 }
6050               }
6051             } else {
6052               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6053             }
6054           }
6055         } else { /* simple transformation block */
6056           PetscInt    row,col;
6057           PetscScalar val,norm;
6058 
6059           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6060           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6061           for (j=0;j<size_of_constraint;j++) {
6062             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6063             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6064             if (!PetscBTLookup(is_primal,row_B)) {
6065               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6066               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6067               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6068             } else {
6069               for (k=0;k<size_of_constraint;k++) {
6070                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6071                 if (row != col) {
6072                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6073                 } else {
6074                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6075                 }
6076                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6077               }
6078             }
6079           }
6080           if (pcbddc->dbg_flag) {
6081             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6082           }
6083         }
6084       } else {
6085         if (pcbddc->dbg_flag) {
6086           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6087         }
6088       }
6089     }
6090 
6091     /* free workspace */
6092     if (qr_needed) {
6093       if (pcbddc->dbg_flag) {
6094         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6095       }
6096       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6097       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6098       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6099       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6100       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6101     }
6102     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6103     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6104     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6105 
6106     /* assembling of global change of variable */
6107     if (!pcbddc->fake_change) {
6108       Mat      tmat;
6109       PetscInt bs;
6110 
6111       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6112       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6113       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6114       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6115       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6116       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6117       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6118       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6119       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6120       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6121       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6122       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6123       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6124       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6125       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6126       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6127       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6128       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6129 
6130       /* check */
6131       if (pcbddc->dbg_flag) {
6132         PetscReal error;
6133         Vec       x,x_change;
6134 
6135         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6136         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6137         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6138         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6139         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6140         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6141         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6142         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6143         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6144         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6145         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6146         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6147         if (error > PETSC_SMALL) {
6148           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6149         }
6150         ierr = VecDestroy(&x);CHKERRQ(ierr);
6151         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6152       }
6153       /* adapt sub_schurs computed (if any) */
6154       if (pcbddc->use_deluxe_scaling) {
6155         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6156 
6157         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);
6158         if (sub_schurs && sub_schurs->S_Ej_all) {
6159           Mat                    S_new,tmat;
6160           IS                     is_all_N,is_V_Sall = NULL;
6161 
6162           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6163           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6164           if (pcbddc->deluxe_zerorows) {
6165             ISLocalToGlobalMapping NtoSall;
6166             IS                     is_V;
6167             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6168             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6169             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6170             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6171             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6172           }
6173           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6174           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6175           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6176           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6177           if (pcbddc->deluxe_zerorows) {
6178             const PetscScalar *array;
6179             const PetscInt    *idxs_V,*idxs_all;
6180             PetscInt          i,n_V;
6181 
6182             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6183             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6184             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6185             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6186             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6187             for (i=0;i<n_V;i++) {
6188               PetscScalar val;
6189               PetscInt    idx;
6190 
6191               idx = idxs_V[i];
6192               val = array[idxs_all[idxs_V[i]]];
6193               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6194             }
6195             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6196             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6197             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6198             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6199             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6200           }
6201           sub_schurs->S_Ej_all = S_new;
6202           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6203           if (sub_schurs->sum_S_Ej_all) {
6204             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6205             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6206             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6207             if (pcbddc->deluxe_zerorows) {
6208               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6209             }
6210             sub_schurs->sum_S_Ej_all = S_new;
6211             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6212           }
6213           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6214           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6215         }
6216         /* destroy any change of basis context in sub_schurs */
6217         if (sub_schurs && sub_schurs->change) {
6218           PetscInt i;
6219 
6220           for (i=0;i<sub_schurs->n_subs;i++) {
6221             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6222           }
6223           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6224         }
6225       }
6226       if (pcbddc->switch_static) { /* need to save the local change */
6227         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6228       } else {
6229         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6230       }
6231       /* determine if any process has changed the pressures locally */
6232       pcbddc->change_interior = pcbddc->benign_have_null;
6233     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6234       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6235       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6236       pcbddc->use_qr_single = qr_needed;
6237     }
6238   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6239     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6240       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6241       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6242     } else {
6243       Mat benign_global = NULL;
6244       if (pcbddc->benign_have_null) {
6245         Mat tmat;
6246 
6247         pcbddc->change_interior = PETSC_TRUE;
6248         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6249         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6250         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6251         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6252         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6253         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6254         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6255         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6256         if (pcbddc->benign_change) {
6257           Mat M;
6258 
6259           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6260           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6261           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6262           ierr = MatDestroy(&M);CHKERRQ(ierr);
6263         } else {
6264           Mat         eye;
6265           PetscScalar *array;
6266 
6267           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6268           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6269           for (i=0;i<pcis->n;i++) {
6270             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6271           }
6272           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6273           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6274           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6275           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6276           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6277         }
6278         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6279         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6280       }
6281       if (pcbddc->user_ChangeOfBasisMatrix) {
6282         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6283         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6284       } else if (pcbddc->benign_have_null) {
6285         pcbddc->ChangeOfBasisMatrix = benign_global;
6286       }
6287     }
6288     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6289       IS             is_global;
6290       const PetscInt *gidxs;
6291 
6292       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6293       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6294       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6295       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6296       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6297     }
6298   }
6299   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6300     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6301   }
6302 
6303   if (!pcbddc->fake_change) {
6304     /* add pressure dofs to set of primal nodes for numbering purposes */
6305     for (i=0;i<pcbddc->benign_n;i++) {
6306       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6307       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6308       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6309       pcbddc->local_primal_size_cc++;
6310       pcbddc->local_primal_size++;
6311     }
6312 
6313     /* check if a new primal space has been introduced (also take into account benign trick) */
6314     pcbddc->new_primal_space_local = PETSC_TRUE;
6315     if (olocal_primal_size == pcbddc->local_primal_size) {
6316       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6317       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6318       if (!pcbddc->new_primal_space_local) {
6319         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6320         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6321       }
6322     }
6323     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6324     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6325   }
6326   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6327 
6328   /* flush dbg viewer */
6329   if (pcbddc->dbg_flag) {
6330     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6331   }
6332 
6333   /* free workspace */
6334   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6335   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6336   if (!pcbddc->adaptive_selection) {
6337     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6338     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6339   } else {
6340     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6341                       pcbddc->adaptive_constraints_idxs_ptr,
6342                       pcbddc->adaptive_constraints_data_ptr,
6343                       pcbddc->adaptive_constraints_idxs,
6344                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6345     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6346     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6347   }
6348   PetscFunctionReturn(0);
6349 }
6350 
6351 #undef __FUNCT__
6352 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6353 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6354 {
6355   ISLocalToGlobalMapping map;
6356   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6357   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6358   PetscInt               i,N;
6359   PetscBool              rcsr = PETSC_FALSE;
6360   PetscErrorCode         ierr;
6361 
6362   PetscFunctionBegin;
6363   if (pcbddc->recompute_topography) {
6364     pcbddc->graphanalyzed = PETSC_FALSE;
6365     /* Reset previously computed graph */
6366     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6367     /* Init local Graph struct */
6368     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6369     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6370     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6371 
6372     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6373       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6374     }
6375     /* Check validity of the csr graph passed in by the user */
6376     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);
6377 
6378     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6379     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6380       PetscInt  *xadj,*adjncy;
6381       PetscInt  nvtxs;
6382       PetscBool flg_row=PETSC_FALSE;
6383 
6384       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6385       if (flg_row) {
6386         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6387         pcbddc->computed_rowadj = PETSC_TRUE;
6388       }
6389       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6390       rcsr = PETSC_TRUE;
6391     }
6392     if (pcbddc->dbg_flag) {
6393       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6394     }
6395 
6396     /* Setup of Graph */
6397     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6398     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6399 
6400     /* attach info on disconnected subdomains if present */
6401     if (pcbddc->n_local_subs) {
6402       PetscInt *local_subs;
6403 
6404       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6405       for (i=0;i<pcbddc->n_local_subs;i++) {
6406         const PetscInt *idxs;
6407         PetscInt       nl,j;
6408 
6409         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6410         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6411         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6412         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6413       }
6414       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6415       pcbddc->mat_graph->local_subs = local_subs;
6416     }
6417   }
6418 
6419   if (!pcbddc->graphanalyzed) {
6420     /* Graph's connected components analysis */
6421     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6422     pcbddc->graphanalyzed = PETSC_TRUE;
6423   }
6424   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6425   PetscFunctionReturn(0);
6426 }
6427 
6428 #undef __FUNCT__
6429 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6430 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6431 {
6432   PetscInt       i,j;
6433   PetscScalar    *alphas;
6434   PetscErrorCode ierr;
6435 
6436   PetscFunctionBegin;
6437   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6438   for (i=0;i<n;i++) {
6439     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6440     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6441     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6442     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6443   }
6444   ierr = PetscFree(alphas);CHKERRQ(ierr);
6445   PetscFunctionReturn(0);
6446 }
6447 
6448 #undef __FUNCT__
6449 #define __FUNCT__ "PCBDDCMatISGetSubassemblingPattern"
6450 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6451 {
6452   Mat            A;
6453   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6454   PetscMPIInt    size,rank,color;
6455   PetscInt       *xadj,*adjncy;
6456   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6457   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6458   PetscInt       void_procs,*procs_candidates = NULL;
6459   PetscInt       xadj_count,*count;
6460   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6461   PetscSubcomm   psubcomm;
6462   MPI_Comm       subcomm;
6463   PetscErrorCode ierr;
6464 
6465   PetscFunctionBegin;
6466   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6467   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6468   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6469   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6470   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6471   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6472 
6473   if (have_void) *have_void = PETSC_FALSE;
6474   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6475   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6476   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6477   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6478   im_active = !!n;
6479   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6480   void_procs = size - active_procs;
6481   /* get ranks of of non-active processes in mat communicator */
6482   if (void_procs) {
6483     PetscInt ncand;
6484 
6485     if (have_void) *have_void = PETSC_TRUE;
6486     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6487     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6488     for (i=0,ncand=0;i<size;i++) {
6489       if (!procs_candidates[i]) {
6490         procs_candidates[ncand++] = i;
6491       }
6492     }
6493     /* force n_subdomains to be not greater that the number of non-active processes */
6494     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6495   }
6496 
6497   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6498      number of subdomains requested 1 -> send to master or first candidate in voids  */
6499   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6500   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6501     PetscInt issize,isidx,dest;
6502     if (*n_subdomains == 1) dest = 0;
6503     else dest = rank;
6504     if (im_active) {
6505       issize = 1;
6506       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6507         isidx = procs_candidates[dest];
6508       } else {
6509         isidx = dest;
6510       }
6511     } else {
6512       issize = 0;
6513       isidx = -1;
6514     }
6515     if (*n_subdomains != 1) *n_subdomains = active_procs;
6516     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6517     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6518     PetscFunctionReturn(0);
6519   }
6520   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6521   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6522   threshold = PetscMax(threshold,2);
6523 
6524   /* Get info on mapping */
6525   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6526 
6527   /* build local CSR graph of subdomains' connectivity */
6528   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6529   xadj[0] = 0;
6530   xadj[1] = PetscMax(n_neighs-1,0);
6531   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6532   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6533   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6534   for (i=1;i<n_neighs;i++)
6535     for (j=0;j<n_shared[i];j++)
6536       count[shared[i][j]] += 1;
6537 
6538   xadj_count = 0;
6539   for (i=1;i<n_neighs;i++) {
6540     for (j=0;j<n_shared[i];j++) {
6541       if (count[shared[i][j]] < threshold) {
6542         adjncy[xadj_count] = neighs[i];
6543         adjncy_wgt[xadj_count] = n_shared[i];
6544         xadj_count++;
6545         break;
6546       }
6547     }
6548   }
6549   xadj[1] = xadj_count;
6550   ierr = PetscFree(count);CHKERRQ(ierr);
6551   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6552   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6553 
6554   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6555 
6556   /* Restrict work on active processes only */
6557   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6558   if (void_procs) {
6559     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6560     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6561     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6562     subcomm = PetscSubcommChild(psubcomm);
6563   } else {
6564     psubcomm = NULL;
6565     subcomm = PetscObjectComm((PetscObject)mat);
6566   }
6567 
6568   v_wgt = NULL;
6569   if (!color) {
6570     ierr = PetscFree(xadj);CHKERRQ(ierr);
6571     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6572     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6573   } else {
6574     Mat             subdomain_adj;
6575     IS              new_ranks,new_ranks_contig;
6576     MatPartitioning partitioner;
6577     PetscInt        rstart=0,rend=0;
6578     PetscInt        *is_indices,*oldranks;
6579     PetscMPIInt     size;
6580     PetscBool       aggregate;
6581 
6582     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6583     if (void_procs) {
6584       PetscInt prank = rank;
6585       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6586       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6587       for (i=0;i<xadj[1];i++) {
6588         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6589       }
6590       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6591     } else {
6592       oldranks = NULL;
6593     }
6594     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6595     if (aggregate) { /* TODO: all this part could be made more efficient */
6596       PetscInt    lrows,row,ncols,*cols;
6597       PetscMPIInt nrank;
6598       PetscScalar *vals;
6599 
6600       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6601       lrows = 0;
6602       if (nrank<redprocs) {
6603         lrows = size/redprocs;
6604         if (nrank<size%redprocs) lrows++;
6605       }
6606       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6607       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6608       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6609       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6610       row = nrank;
6611       ncols = xadj[1]-xadj[0];
6612       cols = adjncy;
6613       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6614       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6615       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6616       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6617       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6618       ierr = PetscFree(xadj);CHKERRQ(ierr);
6619       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6620       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6621       ierr = PetscFree(vals);CHKERRQ(ierr);
6622       if (use_vwgt) {
6623         Vec               v;
6624         const PetscScalar *array;
6625         PetscInt          nl;
6626 
6627         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6628         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6629         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6630         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6631         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6632         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6633         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6634         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6635         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6636         ierr = VecDestroy(&v);CHKERRQ(ierr);
6637       }
6638     } else {
6639       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6640       if (use_vwgt) {
6641         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6642         v_wgt[0] = n;
6643       }
6644     }
6645     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6646 
6647     /* Partition */
6648     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6649     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6650     if (v_wgt) {
6651       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6652     }
6653     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6654     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6655     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6656     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6657     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6658 
6659     /* renumber new_ranks to avoid "holes" in new set of processors */
6660     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6661     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6662     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6663     if (!aggregate) {
6664       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6665 #if defined(PETSC_USE_DEBUG)
6666         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6667 #endif
6668         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6669       } else if (oldranks) {
6670         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6671       } else {
6672         ranks_send_to_idx[0] = is_indices[0];
6673       }
6674     } else {
6675       PetscInt    idxs[1];
6676       PetscMPIInt tag;
6677       MPI_Request *reqs;
6678 
6679       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6680       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6681       for (i=rstart;i<rend;i++) {
6682         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6683       }
6684       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6685       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6686       ierr = PetscFree(reqs);CHKERRQ(ierr);
6687       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6688 #if defined(PETSC_USE_DEBUG)
6689         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6690 #endif
6691         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6692       } else if (oldranks) {
6693         ranks_send_to_idx[0] = oldranks[idxs[0]];
6694       } else {
6695         ranks_send_to_idx[0] = idxs[0];
6696       }
6697     }
6698     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6699     /* clean up */
6700     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6701     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6702     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6703     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6704   }
6705   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6706   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6707 
6708   /* assemble parallel IS for sends */
6709   i = 1;
6710   if (!color) i=0;
6711   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6712   PetscFunctionReturn(0);
6713 }
6714 
6715 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6716 
6717 #undef __FUNCT__
6718 #define __FUNCT__ "PCBDDCMatISSubassemble"
6719 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[])
6720 {
6721   Mat                    local_mat;
6722   IS                     is_sends_internal;
6723   PetscInt               rows,cols,new_local_rows;
6724   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6725   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6726   ISLocalToGlobalMapping l2gmap;
6727   PetscInt*              l2gmap_indices;
6728   const PetscInt*        is_indices;
6729   MatType                new_local_type;
6730   /* buffers */
6731   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6732   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6733   PetscInt               *recv_buffer_idxs_local;
6734   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6735   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6736   /* MPI */
6737   MPI_Comm               comm,comm_n;
6738   PetscSubcomm           subcomm;
6739   PetscMPIInt            n_sends,n_recvs,commsize;
6740   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6741   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6742   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6743   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6744   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6745   PetscErrorCode         ierr;
6746 
6747   PetscFunctionBegin;
6748   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6749   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6750   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6751   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6752   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6753   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6754   PetscValidLogicalCollectiveBool(mat,reuse,6);
6755   PetscValidLogicalCollectiveInt(mat,nis,8);
6756   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6757   if (nvecs) {
6758     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6759     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6760   }
6761   /* further checks */
6762   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6763   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6764   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6765   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6766   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6767   if (reuse && *mat_n) {
6768     PetscInt mrows,mcols,mnrows,mncols;
6769     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6770     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6771     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6772     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6773     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6774     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6775     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6776   }
6777   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6778   PetscValidLogicalCollectiveInt(mat,bs,0);
6779 
6780   /* prepare IS for sending if not provided */
6781   if (!is_sends) {
6782     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6783     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6784   } else {
6785     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6786     is_sends_internal = is_sends;
6787   }
6788 
6789   /* get comm */
6790   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6791 
6792   /* compute number of sends */
6793   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6794   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6795 
6796   /* compute number of receives */
6797   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6798   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6799   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6800   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6801   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6802   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6803   ierr = PetscFree(iflags);CHKERRQ(ierr);
6804 
6805   /* restrict comm if requested */
6806   subcomm = 0;
6807   destroy_mat = PETSC_FALSE;
6808   if (restrict_comm) {
6809     PetscMPIInt color,subcommsize;
6810 
6811     color = 0;
6812     if (restrict_full) {
6813       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6814     } else {
6815       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6816     }
6817     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6818     subcommsize = commsize - subcommsize;
6819     /* check if reuse has been requested */
6820     if (reuse) {
6821       if (*mat_n) {
6822         PetscMPIInt subcommsize2;
6823         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6824         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6825         comm_n = PetscObjectComm((PetscObject)*mat_n);
6826       } else {
6827         comm_n = PETSC_COMM_SELF;
6828       }
6829     } else { /* MAT_INITIAL_MATRIX */
6830       PetscMPIInt rank;
6831 
6832       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6833       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6834       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6835       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6836       comm_n = PetscSubcommChild(subcomm);
6837     }
6838     /* flag to destroy *mat_n if not significative */
6839     if (color) destroy_mat = PETSC_TRUE;
6840   } else {
6841     comm_n = comm;
6842   }
6843 
6844   /* prepare send/receive buffers */
6845   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6846   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6847   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6848   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6849   if (nis) {
6850     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6851   }
6852 
6853   /* Get data from local matrices */
6854   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6855     /* TODO: See below some guidelines on how to prepare the local buffers */
6856     /*
6857        send_buffer_vals should contain the raw values of the local matrix
6858        send_buffer_idxs should contain:
6859        - MatType_PRIVATE type
6860        - PetscInt        size_of_l2gmap
6861        - PetscInt        global_row_indices[size_of_l2gmap]
6862        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6863     */
6864   else {
6865     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6866     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6867     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6868     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6869     send_buffer_idxs[1] = i;
6870     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6871     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6872     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6873     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6874     for (i=0;i<n_sends;i++) {
6875       ilengths_vals[is_indices[i]] = len*len;
6876       ilengths_idxs[is_indices[i]] = len+2;
6877     }
6878   }
6879   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6880   /* additional is (if any) */
6881   if (nis) {
6882     PetscMPIInt psum;
6883     PetscInt j;
6884     for (j=0,psum=0;j<nis;j++) {
6885       PetscInt plen;
6886       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6887       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6888       psum += len+1; /* indices + lenght */
6889     }
6890     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6891     for (j=0,psum=0;j<nis;j++) {
6892       PetscInt plen;
6893       const PetscInt *is_array_idxs;
6894       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6895       send_buffer_idxs_is[psum] = plen;
6896       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6897       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6898       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6899       psum += plen+1; /* indices + lenght */
6900     }
6901     for (i=0;i<n_sends;i++) {
6902       ilengths_idxs_is[is_indices[i]] = psum;
6903     }
6904     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6905   }
6906 
6907   buf_size_idxs = 0;
6908   buf_size_vals = 0;
6909   buf_size_idxs_is = 0;
6910   buf_size_vecs = 0;
6911   for (i=0;i<n_recvs;i++) {
6912     buf_size_idxs += (PetscInt)olengths_idxs[i];
6913     buf_size_vals += (PetscInt)olengths_vals[i];
6914     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6915     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6916   }
6917   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6918   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6919   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6920   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6921 
6922   /* get new tags for clean communications */
6923   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6924   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6925   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6926   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6927 
6928   /* allocate for requests */
6929   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6930   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6931   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6932   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6933   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6934   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6935   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6936   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6937 
6938   /* communications */
6939   ptr_idxs = recv_buffer_idxs;
6940   ptr_vals = recv_buffer_vals;
6941   ptr_idxs_is = recv_buffer_idxs_is;
6942   ptr_vecs = recv_buffer_vecs;
6943   for (i=0;i<n_recvs;i++) {
6944     source_dest = onodes[i];
6945     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6946     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6947     ptr_idxs += olengths_idxs[i];
6948     ptr_vals += olengths_vals[i];
6949     if (nis) {
6950       source_dest = onodes_is[i];
6951       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);
6952       ptr_idxs_is += olengths_idxs_is[i];
6953     }
6954     if (nvecs) {
6955       source_dest = onodes[i];
6956       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6957       ptr_vecs += olengths_idxs[i]-2;
6958     }
6959   }
6960   for (i=0;i<n_sends;i++) {
6961     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6962     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6963     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6964     if (nis) {
6965       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);
6966     }
6967     if (nvecs) {
6968       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6969       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6970     }
6971   }
6972   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6973   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6974 
6975   /* assemble new l2g map */
6976   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6977   ptr_idxs = recv_buffer_idxs;
6978   new_local_rows = 0;
6979   for (i=0;i<n_recvs;i++) {
6980     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6981     ptr_idxs += olengths_idxs[i];
6982   }
6983   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6984   ptr_idxs = recv_buffer_idxs;
6985   new_local_rows = 0;
6986   for (i=0;i<n_recvs;i++) {
6987     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6988     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6989     ptr_idxs += olengths_idxs[i];
6990   }
6991   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6992   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6993   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6994 
6995   /* infer new local matrix type from received local matrices type */
6996   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
6997   /* 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) */
6998   if (n_recvs) {
6999     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7000     ptr_idxs = recv_buffer_idxs;
7001     for (i=0;i<n_recvs;i++) {
7002       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7003         new_local_type_private = MATAIJ_PRIVATE;
7004         break;
7005       }
7006       ptr_idxs += olengths_idxs[i];
7007     }
7008     switch (new_local_type_private) {
7009       case MATDENSE_PRIVATE:
7010         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
7011           new_local_type = MATSEQAIJ;
7012           bs = 1;
7013         } else { /* if I receive only 1 dense matrix */
7014           new_local_type = MATSEQDENSE;
7015           bs = 1;
7016         }
7017         break;
7018       case MATAIJ_PRIVATE:
7019         new_local_type = MATSEQAIJ;
7020         bs = 1;
7021         break;
7022       case MATBAIJ_PRIVATE:
7023         new_local_type = MATSEQBAIJ;
7024         break;
7025       case MATSBAIJ_PRIVATE:
7026         new_local_type = MATSEQSBAIJ;
7027         break;
7028       default:
7029         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
7030         break;
7031     }
7032   } else { /* by default, new_local_type is seqdense */
7033     new_local_type = MATSEQDENSE;
7034     bs = 1;
7035   }
7036 
7037   /* create MATIS object if needed */
7038   if (!reuse) {
7039     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7040     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7041   } else {
7042     /* it also destroys the local matrices */
7043     if (*mat_n) {
7044       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7045     } else { /* this is a fake object */
7046       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7047     }
7048   }
7049   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7050   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7051 
7052   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7053 
7054   /* Global to local map of received indices */
7055   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7056   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7057   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7058 
7059   /* restore attributes -> type of incoming data and its size */
7060   buf_size_idxs = 0;
7061   for (i=0;i<n_recvs;i++) {
7062     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7063     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7064     buf_size_idxs += (PetscInt)olengths_idxs[i];
7065   }
7066   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7067 
7068   /* set preallocation */
7069   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7070   if (!newisdense) {
7071     PetscInt *new_local_nnz=0;
7072 
7073     ptr_idxs = recv_buffer_idxs_local;
7074     if (n_recvs) {
7075       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7076     }
7077     for (i=0;i<n_recvs;i++) {
7078       PetscInt j;
7079       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7080         for (j=0;j<*(ptr_idxs+1);j++) {
7081           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7082         }
7083       } else {
7084         /* TODO */
7085       }
7086       ptr_idxs += olengths_idxs[i];
7087     }
7088     if (new_local_nnz) {
7089       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7090       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7091       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7092       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7093       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7094       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7095     } else {
7096       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7097     }
7098     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7099   } else {
7100     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7101   }
7102 
7103   /* set values */
7104   ptr_vals = recv_buffer_vals;
7105   ptr_idxs = recv_buffer_idxs_local;
7106   for (i=0;i<n_recvs;i++) {
7107     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7108       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7109       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7110       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7111       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7112       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7113     } else {
7114       /* TODO */
7115     }
7116     ptr_idxs += olengths_idxs[i];
7117     ptr_vals += olengths_vals[i];
7118   }
7119   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7120   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7121   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7122   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7123   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7124 
7125 #if 0
7126   if (!restrict_comm) { /* check */
7127     Vec       lvec,rvec;
7128     PetscReal infty_error;
7129 
7130     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7131     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7132     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7133     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7134     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7135     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7136     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7137     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7138     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7139   }
7140 #endif
7141 
7142   /* assemble new additional is (if any) */
7143   if (nis) {
7144     PetscInt **temp_idxs,*count_is,j,psum;
7145 
7146     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7147     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7148     ptr_idxs = recv_buffer_idxs_is;
7149     psum = 0;
7150     for (i=0;i<n_recvs;i++) {
7151       for (j=0;j<nis;j++) {
7152         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7153         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7154         psum += plen;
7155         ptr_idxs += plen+1; /* shift pointer to received data */
7156       }
7157     }
7158     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7159     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7160     for (i=1;i<nis;i++) {
7161       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7162     }
7163     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7164     ptr_idxs = recv_buffer_idxs_is;
7165     for (i=0;i<n_recvs;i++) {
7166       for (j=0;j<nis;j++) {
7167         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7168         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7169         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7170         ptr_idxs += plen+1; /* shift pointer to received data */
7171       }
7172     }
7173     for (i=0;i<nis;i++) {
7174       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7175       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7176       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7177     }
7178     ierr = PetscFree(count_is);CHKERRQ(ierr);
7179     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7180     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7181   }
7182   /* free workspace */
7183   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7184   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7185   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7186   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7187   if (isdense) {
7188     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7189     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7190   } else {
7191     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7192   }
7193   if (nis) {
7194     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7195     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7196   }
7197 
7198   if (nvecs) {
7199     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7200     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7201     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7202     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7203     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7204     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7205     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7206     /* set values */
7207     ptr_vals = recv_buffer_vecs;
7208     ptr_idxs = recv_buffer_idxs_local;
7209     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7210     for (i=0;i<n_recvs;i++) {
7211       PetscInt j;
7212       for (j=0;j<*(ptr_idxs+1);j++) {
7213         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7214       }
7215       ptr_idxs += olengths_idxs[i];
7216       ptr_vals += olengths_idxs[i]-2;
7217     }
7218     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7219     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7220     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7221   }
7222 
7223   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7224   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7225   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7226   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7227   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7228   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7229   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7230   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7231   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7232   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7233   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7234   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7235   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7236   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7237   ierr = PetscFree(onodes);CHKERRQ(ierr);
7238   if (nis) {
7239     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7240     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7241     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7242   }
7243   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7244   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7245     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7246     for (i=0;i<nis;i++) {
7247       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7248     }
7249     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7250       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7251     }
7252     *mat_n = NULL;
7253   }
7254   PetscFunctionReturn(0);
7255 }
7256 
7257 /* temporary hack into ksp private data structure */
7258 #include <petsc/private/kspimpl.h>
7259 
7260 #undef __FUNCT__
7261 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7262 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7263 {
7264   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7265   PC_IS                  *pcis = (PC_IS*)pc->data;
7266   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7267   Mat                    coarsedivudotp = NULL;
7268   Mat                    coarseG,t_coarse_mat_is;
7269   MatNullSpace           CoarseNullSpace = NULL;
7270   ISLocalToGlobalMapping coarse_islg;
7271   IS                     coarse_is,*isarray;
7272   PetscInt               i,im_active=-1,active_procs=-1;
7273   PetscInt               nis,nisdofs,nisneu,nisvert;
7274   PC                     pc_temp;
7275   PCType                 coarse_pc_type;
7276   KSPType                coarse_ksp_type;
7277   PetscBool              multilevel_requested,multilevel_allowed;
7278   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7279   PetscInt               ncoarse,nedcfield;
7280   PetscBool              compute_vecs = PETSC_FALSE;
7281   PetscScalar            *array;
7282   MatReuse               coarse_mat_reuse;
7283   PetscBool              restr, full_restr, have_void;
7284   PetscErrorCode         ierr;
7285 
7286   PetscFunctionBegin;
7287   /* Assign global numbering to coarse dofs */
7288   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 */
7289     PetscInt ocoarse_size;
7290     compute_vecs = PETSC_TRUE;
7291     ocoarse_size = pcbddc->coarse_size;
7292     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7293     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7294     /* see if we can avoid some work */
7295     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7296       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7297       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7298         PC        pc;
7299         PetscBool isbddc;
7300 
7301         /* temporary workaround since PCBDDC does not have a reset method so far */
7302         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7303         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7304         if (isbddc) {
7305           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7306         } else {
7307           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7308         }
7309         coarse_reuse = PETSC_FALSE;
7310       } else { /* we can safely reuse already computed coarse matrix */
7311         coarse_reuse = PETSC_TRUE;
7312       }
7313     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7314       coarse_reuse = PETSC_FALSE;
7315     }
7316     /* reset any subassembling information */
7317     if (!coarse_reuse || pcbddc->recompute_topography) {
7318       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7319     }
7320   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7321     coarse_reuse = PETSC_TRUE;
7322   }
7323   /* assemble coarse matrix */
7324   if (coarse_reuse && pcbddc->coarse_ksp) {
7325     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7326     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7327     coarse_mat_reuse = MAT_REUSE_MATRIX;
7328   } else {
7329     coarse_mat = NULL;
7330     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7331   }
7332 
7333   /* creates temporary l2gmap and IS for coarse indexes */
7334   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7335   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7336 
7337   /* creates temporary MATIS object for coarse matrix */
7338   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7339   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7340   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7341   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7342   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);
7343   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7344   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7345   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7346   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7347 
7348   /* count "active" (i.e. with positive local size) and "void" processes */
7349   im_active = !!(pcis->n);
7350   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7351 
7352   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7353   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7354   /* full_restr : just use the receivers from the subassembling pattern */
7355   coarse_mat_is = NULL;
7356   multilevel_allowed = PETSC_FALSE;
7357   multilevel_requested = PETSC_FALSE;
7358   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7359   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7360   if (multilevel_requested) {
7361     ncoarse = active_procs/pcbddc->coarsening_ratio;
7362     restr = PETSC_FALSE;
7363     full_restr = PETSC_FALSE;
7364   } else {
7365     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7366     restr = PETSC_TRUE;
7367     full_restr = PETSC_TRUE;
7368   }
7369   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7370   ncoarse = PetscMax(1,ncoarse);
7371   if (!pcbddc->coarse_subassembling) {
7372     if (pcbddc->coarsening_ratio > 1) {
7373       if (multilevel_requested) {
7374         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7375       } else {
7376         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7377       }
7378     } else {
7379       PetscMPIInt size,rank;
7380       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7381       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7382       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7383       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7384     }
7385   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7386     PetscInt    psum;
7387     PetscMPIInt size;
7388     if (pcbddc->coarse_ksp) psum = 1;
7389     else psum = 0;
7390     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7391     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7392     if (ncoarse < size) have_void = PETSC_TRUE;
7393   }
7394   /* determine if we can go multilevel */
7395   if (multilevel_requested) {
7396     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7397     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7398   }
7399   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7400 
7401   /* dump subassembling pattern */
7402   if (pcbddc->dbg_flag && multilevel_allowed) {
7403     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7404   }
7405 
7406   /* compute dofs splitting and neumann boundaries for coarse dofs */
7407   nedcfield = -1;
7408   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7409     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7410     const PetscInt         *idxs;
7411     ISLocalToGlobalMapping tmap;
7412 
7413     /* create map between primal indices (in local representative ordering) and local primal numbering */
7414     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7415     /* allocate space for temporary storage */
7416     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7417     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7418     /* allocate for IS array */
7419     nisdofs = pcbddc->n_ISForDofsLocal;
7420     if (pcbddc->nedclocal) {
7421       if (pcbddc->nedfield > -1) {
7422         nedcfield = pcbddc->nedfield;
7423       } else {
7424         nedcfield = 0;
7425         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7426         nisdofs = 1;
7427       }
7428     }
7429     nisneu = !!pcbddc->NeumannBoundariesLocal;
7430     nisvert = 0; /* nisvert is not used */
7431     nis = nisdofs + nisneu + nisvert;
7432     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7433     /* dofs splitting */
7434     for (i=0;i<nisdofs;i++) {
7435       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7436       if (nedcfield != i) {
7437         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7438         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7439         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7440         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7441       } else {
7442         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7443         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7444         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7445         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7446         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7447       }
7448       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7449       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7450       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7451     }
7452     /* neumann boundaries */
7453     if (pcbddc->NeumannBoundariesLocal) {
7454       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7455       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7456       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7457       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7458       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7459       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7460       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7461       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7462     }
7463     /* free memory */
7464     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7465     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7466     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7467   } else {
7468     nis = 0;
7469     nisdofs = 0;
7470     nisneu = 0;
7471     nisvert = 0;
7472     isarray = NULL;
7473   }
7474   /* destroy no longer needed map */
7475   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7476 
7477   /* subassemble */
7478   if (multilevel_allowed) {
7479     Vec       vp[1];
7480     PetscInt  nvecs = 0;
7481     PetscBool reuse,reuser;
7482 
7483     if (coarse_mat) reuse = PETSC_TRUE;
7484     else reuse = PETSC_FALSE;
7485     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7486     vp[0] = NULL;
7487     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7488       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7489       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7490       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7491       nvecs = 1;
7492 
7493       if (pcbddc->divudotp) {
7494         Mat      B,loc_divudotp;
7495         Vec      v,p;
7496         IS       dummy;
7497         PetscInt np;
7498 
7499         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7500         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7501         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7502         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7503         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7504         ierr = VecSet(p,1.);CHKERRQ(ierr);
7505         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7506         ierr = VecDestroy(&p);CHKERRQ(ierr);
7507         ierr = MatDestroy(&B);CHKERRQ(ierr);
7508         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7509         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7510         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7511         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7512         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7513         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7514         ierr = VecDestroy(&v);CHKERRQ(ierr);
7515       }
7516     }
7517     if (reuser) {
7518       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7519     } else {
7520       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7521     }
7522     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7523       PetscScalar *arraym,*arrayv;
7524       PetscInt    nl;
7525       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7526       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7527       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7528       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7529       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7530       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7531       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7532       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7533     } else {
7534       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7535     }
7536   } else {
7537     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7538   }
7539   if (coarse_mat_is || coarse_mat) {
7540     PetscMPIInt size;
7541     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7542     if (!multilevel_allowed) {
7543       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7544     } else {
7545       Mat A;
7546 
7547       /* if this matrix is present, it means we are not reusing the coarse matrix */
7548       if (coarse_mat_is) {
7549         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7550         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7551         coarse_mat = coarse_mat_is;
7552       }
7553       /* be sure we don't have MatSeqDENSE as local mat */
7554       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7555       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7556     }
7557   }
7558   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7559   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7560 
7561   /* create local to global scatters for coarse problem */
7562   if (compute_vecs) {
7563     PetscInt lrows;
7564     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7565     if (coarse_mat) {
7566       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7567     } else {
7568       lrows = 0;
7569     }
7570     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7571     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7572     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7573     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7574     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7575   }
7576   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7577 
7578   /* set defaults for coarse KSP and PC */
7579   if (multilevel_allowed) {
7580     coarse_ksp_type = KSPRICHARDSON;
7581     coarse_pc_type = PCBDDC;
7582   } else {
7583     coarse_ksp_type = KSPPREONLY;
7584     coarse_pc_type = PCREDUNDANT;
7585   }
7586 
7587   /* print some info if requested */
7588   if (pcbddc->dbg_flag) {
7589     if (!multilevel_allowed) {
7590       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7591       if (multilevel_requested) {
7592         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);
7593       } else if (pcbddc->max_levels) {
7594         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7595       }
7596       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7597     }
7598   }
7599 
7600   /* communicate coarse discrete gradient */
7601   coarseG = NULL;
7602   if (pcbddc->nedcG && multilevel_allowed) {
7603     MPI_Comm ccomm;
7604     if (coarse_mat) {
7605       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7606     } else {
7607       ccomm = MPI_COMM_NULL;
7608     }
7609     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7610   }
7611 
7612   /* create the coarse KSP object only once with defaults */
7613   if (coarse_mat) {
7614     PetscViewer dbg_viewer = NULL;
7615     if (pcbddc->dbg_flag) {
7616       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7617       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7618     }
7619     if (!pcbddc->coarse_ksp) {
7620       char prefix[256],str_level[16];
7621       size_t len;
7622 
7623       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7624       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7625       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7626       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7627       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7628       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7629       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7630       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7631       /* TODO is this logic correct? should check for coarse_mat type */
7632       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7633       /* prefix */
7634       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7635       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7636       if (!pcbddc->current_level) {
7637         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7638         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7639       } else {
7640         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7641         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7642         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7643         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7644         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7645         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7646       }
7647       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7648       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7649       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7650       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7651       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7652       /* allow user customization */
7653       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7654     }
7655     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7656     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7657     if (nisdofs) {
7658       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7659       for (i=0;i<nisdofs;i++) {
7660         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7661       }
7662     }
7663     if (nisneu) {
7664       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7665       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7666     }
7667     if (nisvert) {
7668       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7669       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7670     }
7671     if (coarseG) {
7672       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7673     }
7674 
7675     /* get some info after set from options */
7676     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7677     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7678     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7679     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7680       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7681       isbddc = PETSC_FALSE;
7682     }
7683     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7684     if (isredundant) {
7685       KSP inner_ksp;
7686       PC  inner_pc;
7687       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7688       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7689       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7690     }
7691 
7692     /* parameters which miss an API */
7693     if (isbddc) {
7694       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7695       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7696       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7697       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7698       if (pcbddc_coarse->benign_saddle_point) {
7699         Mat                    coarsedivudotp_is;
7700         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7701         IS                     row,col;
7702         const PetscInt         *gidxs;
7703         PetscInt               n,st,M,N;
7704 
7705         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7706         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7707         st = st-n;
7708         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7709         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7710         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7711         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7712         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7713         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7714         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7715         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7716         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7717         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7718         ierr = ISDestroy(&row);CHKERRQ(ierr);
7719         ierr = ISDestroy(&col);CHKERRQ(ierr);
7720         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7721         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7722         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7723         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7724         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7725         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7726         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7727         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7728         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7729         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7730         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7731         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7732       }
7733     }
7734 
7735     /* propagate symmetry info of coarse matrix */
7736     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7737     if (pc->pmat->symmetric_set) {
7738       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7739     }
7740     if (pc->pmat->hermitian_set) {
7741       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7742     }
7743     if (pc->pmat->spd_set) {
7744       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7745     }
7746     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7747       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7748     }
7749     /* set operators */
7750     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7751     if (pcbddc->dbg_flag) {
7752       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7753     }
7754   }
7755   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7756   ierr = PetscFree(isarray);CHKERRQ(ierr);
7757 #if 0
7758   {
7759     PetscViewer viewer;
7760     char filename[256];
7761     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7762     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7763     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7764     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7765     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7766     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7767   }
7768 #endif
7769 
7770   if (pcbddc->coarse_ksp) {
7771     Vec crhs,csol;
7772 
7773     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7774     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7775     if (!csol) {
7776       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7777     }
7778     if (!crhs) {
7779       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7780     }
7781   }
7782   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7783 
7784   /* compute null space for coarse solver if the benign trick has been requested */
7785   if (pcbddc->benign_null) {
7786 
7787     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7788     for (i=0;i<pcbddc->benign_n;i++) {
7789       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7790     }
7791     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7792     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7793     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7794     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7795     if (coarse_mat) {
7796       Vec         nullv;
7797       PetscScalar *array,*array2;
7798       PetscInt    nl;
7799 
7800       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7801       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7802       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7803       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7804       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7805       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7806       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7807       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7808       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7809       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7810     }
7811   }
7812 
7813   if (pcbddc->coarse_ksp) {
7814     PetscBool ispreonly;
7815 
7816     if (CoarseNullSpace) {
7817       PetscBool isnull;
7818       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7819       if (isnull) {
7820         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7821       }
7822       /* TODO: add local nullspaces (if any) */
7823     }
7824     /* setup coarse ksp */
7825     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7826     /* Check coarse problem if in debug mode or if solving with an iterative method */
7827     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7828     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7829       KSP       check_ksp;
7830       KSPType   check_ksp_type;
7831       PC        check_pc;
7832       Vec       check_vec,coarse_vec;
7833       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7834       PetscInt  its;
7835       PetscBool compute_eigs;
7836       PetscReal *eigs_r,*eigs_c;
7837       PetscInt  neigs;
7838       const char *prefix;
7839 
7840       /* Create ksp object suitable for estimation of extreme eigenvalues */
7841       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7842       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7843       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7844       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7845       /* prevent from setup unneeded object */
7846       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7847       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7848       if (ispreonly) {
7849         check_ksp_type = KSPPREONLY;
7850         compute_eigs = PETSC_FALSE;
7851       } else {
7852         check_ksp_type = KSPGMRES;
7853         compute_eigs = PETSC_TRUE;
7854       }
7855       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7856       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7857       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7858       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7859       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7860       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7861       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7862       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7863       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7864       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7865       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7866       /* create random vec */
7867       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7868       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7869       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7870       /* solve coarse problem */
7871       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7872       /* set eigenvalue estimation if preonly has not been requested */
7873       if (compute_eigs) {
7874         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7875         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7876         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7877         if (neigs) {
7878           lambda_max = eigs_r[neigs-1];
7879           lambda_min = eigs_r[0];
7880           if (pcbddc->use_coarse_estimates) {
7881             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7882               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7883               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7884             }
7885           }
7886         }
7887       }
7888 
7889       /* check coarse problem residual error */
7890       if (pcbddc->dbg_flag) {
7891         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7892         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7893         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7894         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7895         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7896         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7897         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7898         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7899         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7900         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7901         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7902         if (CoarseNullSpace) {
7903           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7904         }
7905         if (compute_eigs) {
7906           PetscReal          lambda_max_s,lambda_min_s;
7907           KSPConvergedReason reason;
7908           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7909           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7910           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7911           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7912           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);
7913           for (i=0;i<neigs;i++) {
7914             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7915           }
7916         }
7917         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7918         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7919       }
7920       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7921       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7922       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7923       if (compute_eigs) {
7924         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7925         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7926       }
7927     }
7928   }
7929   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7930   /* print additional info */
7931   if (pcbddc->dbg_flag) {
7932     /* waits until all processes reaches this point */
7933     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7934     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7935     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7936   }
7937 
7938   /* free memory */
7939   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7940   PetscFunctionReturn(0);
7941 }
7942 
7943 #undef __FUNCT__
7944 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7945 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7946 {
7947   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7948   PC_IS*         pcis = (PC_IS*)pc->data;
7949   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7950   IS             subset,subset_mult,subset_n;
7951   PetscInt       local_size,coarse_size=0;
7952   PetscInt       *local_primal_indices=NULL;
7953   const PetscInt *t_local_primal_indices;
7954   PetscErrorCode ierr;
7955 
7956   PetscFunctionBegin;
7957   /* Compute global number of coarse dofs */
7958   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7959   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7960   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7961   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7962   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7963   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7964   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7965   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7966   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7967   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);
7968   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7969   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7970   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7971   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7972   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7973 
7974   /* check numbering */
7975   if (pcbddc->dbg_flag) {
7976     PetscScalar coarsesum,*array,*array2;
7977     PetscInt    i;
7978     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7979 
7980     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7981     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7982     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7983     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7984     /* counter */
7985     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7986     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7987     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7988     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7989     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7990     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7991     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7992     for (i=0;i<pcbddc->local_primal_size;i++) {
7993       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7994     }
7995     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7996     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
7997     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7998     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7999     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8000     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8001     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8002     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8003     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8004     for (i=0;i<pcis->n;i++) {
8005       if (array[i] != 0.0 && array[i] != array2[i]) {
8006         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8007         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8008         set_error = PETSC_TRUE;
8009         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8010         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);
8011       }
8012     }
8013     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8014     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8015     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8016     for (i=0;i<pcis->n;i++) {
8017       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8018     }
8019     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8020     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8021     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8022     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8023     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8024     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8025     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8026       PetscInt *gidxs;
8027 
8028       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8029       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8030       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8031       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8032       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8033       for (i=0;i<pcbddc->local_primal_size;i++) {
8034         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);
8035       }
8036       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8037       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8038     }
8039     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8040     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8041     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8042   }
8043   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8044   /* get back data */
8045   *coarse_size_n = coarse_size;
8046   *local_primal_indices_n = local_primal_indices;
8047   PetscFunctionReturn(0);
8048 }
8049 
8050 #undef __FUNCT__
8051 #define __FUNCT__ "PCBDDCGlobalToLocal"
8052 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8053 {
8054   IS             localis_t;
8055   PetscInt       i,lsize,*idxs,n;
8056   PetscScalar    *vals;
8057   PetscErrorCode ierr;
8058 
8059   PetscFunctionBegin;
8060   /* get indices in local ordering exploiting local to global map */
8061   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8062   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8063   for (i=0;i<lsize;i++) vals[i] = 1.0;
8064   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8065   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8066   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8067   if (idxs) { /* multilevel guard */
8068     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8069   }
8070   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8071   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8072   ierr = PetscFree(vals);CHKERRQ(ierr);
8073   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8074   /* now compute set in local ordering */
8075   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8076   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8077   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8078   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8079   for (i=0,lsize=0;i<n;i++) {
8080     if (PetscRealPart(vals[i]) > 0.5) {
8081       lsize++;
8082     }
8083   }
8084   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8085   for (i=0,lsize=0;i<n;i++) {
8086     if (PetscRealPart(vals[i]) > 0.5) {
8087       idxs[lsize++] = i;
8088     }
8089   }
8090   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8091   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8092   *localis = localis_t;
8093   PetscFunctionReturn(0);
8094 }
8095 
8096 #undef __FUNCT__
8097 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8098 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8099 {
8100   PC_IS               *pcis=(PC_IS*)pc->data;
8101   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8102   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8103   Mat                 S_j;
8104   PetscInt            *used_xadj,*used_adjncy;
8105   PetscBool           free_used_adj;
8106   PetscErrorCode      ierr;
8107 
8108   PetscFunctionBegin;
8109   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8110   free_used_adj = PETSC_FALSE;
8111   if (pcbddc->sub_schurs_layers == -1) {
8112     used_xadj = NULL;
8113     used_adjncy = NULL;
8114   } else {
8115     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8116       used_xadj = pcbddc->mat_graph->xadj;
8117       used_adjncy = pcbddc->mat_graph->adjncy;
8118     } else if (pcbddc->computed_rowadj) {
8119       used_xadj = pcbddc->mat_graph->xadj;
8120       used_adjncy = pcbddc->mat_graph->adjncy;
8121     } else {
8122       PetscBool      flg_row=PETSC_FALSE;
8123       const PetscInt *xadj,*adjncy;
8124       PetscInt       nvtxs;
8125 
8126       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8127       if (flg_row) {
8128         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8129         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8130         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8131         free_used_adj = PETSC_TRUE;
8132       } else {
8133         pcbddc->sub_schurs_layers = -1;
8134         used_xadj = NULL;
8135         used_adjncy = NULL;
8136       }
8137       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8138     }
8139   }
8140 
8141   /* setup sub_schurs data */
8142   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8143   if (!sub_schurs->schur_explicit) {
8144     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8145     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8146     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);
8147   } else {
8148     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8149     PetscBool isseqaij,need_change = PETSC_FALSE;
8150     PetscInt  benign_n;
8151     Mat       change = NULL;
8152     Vec       scaling = NULL;
8153     IS        change_primal = NULL;
8154 
8155     if (!pcbddc->use_vertices && reuse_solvers) {
8156       PetscInt n_vertices;
8157 
8158       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8159       reuse_solvers = (PetscBool)!n_vertices;
8160     }
8161     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8162     if (!isseqaij) {
8163       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8164       if (matis->A == pcbddc->local_mat) {
8165         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8166         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8167       } else {
8168         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8169       }
8170     }
8171     if (!pcbddc->benign_change_explicit) {
8172       benign_n = pcbddc->benign_n;
8173     } else {
8174       benign_n = 0;
8175     }
8176     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8177        We need a global reduction to avoid possible deadlocks.
8178        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8179     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8180       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8181       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8182       need_change = (PetscBool)(!need_change);
8183     }
8184     /* If the user defines additional constraints, we import them here.
8185        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 */
8186     if (need_change) {
8187       PC_IS   *pcisf;
8188       PC_BDDC *pcbddcf;
8189       PC      pcf;
8190 
8191       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8192       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8193       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8194       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8195       /* hacks */
8196       pcisf = (PC_IS*)pcf->data;
8197       pcisf->is_B_local = pcis->is_B_local;
8198       pcisf->vec1_N = pcis->vec1_N;
8199       pcisf->BtoNmap = pcis->BtoNmap;
8200       pcisf->n = pcis->n;
8201       pcisf->n_B = pcis->n_B;
8202       pcbddcf = (PC_BDDC*)pcf->data;
8203       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8204       pcbddcf->mat_graph = pcbddc->mat_graph;
8205       pcbddcf->use_faces = PETSC_TRUE;
8206       pcbddcf->use_change_of_basis = PETSC_TRUE;
8207       pcbddcf->use_change_on_faces = PETSC_TRUE;
8208       pcbddcf->use_qr_single = PETSC_TRUE;
8209       pcbddcf->fake_change = PETSC_TRUE;
8210       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8211       /* store information on primal vertices and change of basis (in local numbering) */
8212       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8213       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8214       change = pcbddcf->ConstraintMatrix;
8215       pcbddcf->ConstraintMatrix = NULL;
8216       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8217       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8218       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8219       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8220       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8221       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8222       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8223       pcf->ops->destroy = NULL;
8224       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8225     }
8226     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8227     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);
8228     ierr = MatDestroy(&change);CHKERRQ(ierr);
8229     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8230   }
8231   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8232 
8233   /* free adjacency */
8234   if (free_used_adj) {
8235     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8236   }
8237   PetscFunctionReturn(0);
8238 }
8239 
8240 #undef __FUNCT__
8241 #define __FUNCT__ "PCBDDCInitSubSchurs"
8242 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8243 {
8244   PC_IS               *pcis=(PC_IS*)pc->data;
8245   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8246   PCBDDCGraph         graph;
8247   PetscErrorCode      ierr;
8248 
8249   PetscFunctionBegin;
8250   /* attach interface graph for determining subsets */
8251   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8252     IS       verticesIS,verticescomm;
8253     PetscInt vsize,*idxs;
8254 
8255     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8256     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8257     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8258     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8259     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8260     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8261     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8262     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8263     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8264     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8265     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8266   } else {
8267     graph = pcbddc->mat_graph;
8268   }
8269   /* print some info */
8270   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8271     IS       vertices;
8272     PetscInt nv,nedges,nfaces;
8273     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8274     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8275     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8276     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8277     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8278     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8279     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8280     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8281     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8282     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8283     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8284   }
8285 
8286   /* sub_schurs init */
8287   if (!pcbddc->sub_schurs) {
8288     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8289   }
8290   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8291 
8292   /* free graph struct */
8293   if (pcbddc->sub_schurs_rebuild) {
8294     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8295   }
8296   PetscFunctionReturn(0);
8297 }
8298 
8299 #undef __FUNCT__
8300 #define __FUNCT__ "PCBDDCCheckOperator"
8301 PetscErrorCode PCBDDCCheckOperator(PC pc)
8302 {
8303   PC_IS               *pcis=(PC_IS*)pc->data;
8304   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8305   PetscErrorCode      ierr;
8306 
8307   PetscFunctionBegin;
8308   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8309     IS             zerodiag = NULL;
8310     Mat            S_j,B0_B=NULL;
8311     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8312     PetscScalar    *p0_check,*array,*array2;
8313     PetscReal      norm;
8314     PetscInt       i;
8315 
8316     /* B0 and B0_B */
8317     if (zerodiag) {
8318       IS       dummy;
8319 
8320       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8321       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8322       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8323       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8324     }
8325     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8326     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8327     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8328     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8329     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8330     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8331     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8332     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8333     /* S_j */
8334     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8335     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8336 
8337     /* mimic vector in \widetilde{W}_\Gamma */
8338     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8339     /* continuous in primal space */
8340     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8341     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8342     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8343     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8344     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8345     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8346     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8347     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8348     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8349     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8350     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8351     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8352     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8353     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8354 
8355     /* assemble rhs for coarse problem */
8356     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8357     /* local with Schur */
8358     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8359     if (zerodiag) {
8360       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8361       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8362       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8363       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8364     }
8365     /* sum on primal nodes the local contributions */
8366     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8367     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8368     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8369     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8370     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8371     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8372     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8373     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8374     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8375     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8376     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8377     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8378     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8379     /* scale primal nodes (BDDC sums contibutions) */
8380     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8381     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8382     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8383     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8384     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8385     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8386     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8387     /* global: \widetilde{B0}_B w_\Gamma */
8388     if (zerodiag) {
8389       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8390       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8391       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8392       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8393     }
8394     /* BDDC */
8395     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8396     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8397 
8398     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8399     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8400     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8401     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8402     for (i=0;i<pcbddc->benign_n;i++) {
8403       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8404     }
8405     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8406     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8407     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8408     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8409     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8410     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8411   }
8412   PetscFunctionReturn(0);
8413 }
8414 
8415 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8416 #undef __FUNCT__
8417 #define __FUNCT__ "MatMPIAIJRestrict"
8418 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8419 {
8420   Mat            At;
8421   IS             rows;
8422   PetscInt       rst,ren;
8423   PetscErrorCode ierr;
8424   PetscLayout    rmap;
8425 
8426   PetscFunctionBegin;
8427   rst = ren = 0;
8428   if (ccomm != MPI_COMM_NULL) {
8429     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8430     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8431     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8432     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8433     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8434   }
8435   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8436   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8437   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8438 
8439   if (ccomm != MPI_COMM_NULL) {
8440     Mat_MPIAIJ *a,*b;
8441     IS         from,to;
8442     Vec        gvec;
8443     PetscInt   lsize;
8444 
8445     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8446     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8447     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8448     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8449     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8450     a    = (Mat_MPIAIJ*)At->data;
8451     b    = (Mat_MPIAIJ*)(*B)->data;
8452     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8453     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8454     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8455     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8456     b->A = a->A;
8457     b->B = a->B;
8458 
8459     b->donotstash      = a->donotstash;
8460     b->roworiented     = a->roworiented;
8461     b->rowindices      = 0;
8462     b->rowvalues       = 0;
8463     b->getrowactive    = PETSC_FALSE;
8464 
8465     (*B)->rmap         = rmap;
8466     (*B)->factortype   = A->factortype;
8467     (*B)->assembled    = PETSC_TRUE;
8468     (*B)->insertmode   = NOT_SET_VALUES;
8469     (*B)->preallocated = PETSC_TRUE;
8470 
8471     if (a->colmap) {
8472 #if defined(PETSC_USE_CTABLE)
8473       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8474 #else
8475       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8476       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8477       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8478 #endif
8479     } else b->colmap = 0;
8480     if (a->garray) {
8481       PetscInt len;
8482       len  = a->B->cmap->n;
8483       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8484       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8485       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8486     } else b->garray = 0;
8487 
8488     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8489     b->lvec = a->lvec;
8490     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8491 
8492     /* cannot use VecScatterCopy */
8493     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8494     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8495     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8496     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8497     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8498     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8499     ierr = ISDestroy(&from);CHKERRQ(ierr);
8500     ierr = ISDestroy(&to);CHKERRQ(ierr);
8501     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8502   }
8503   ierr = MatDestroy(&At);CHKERRQ(ierr);
8504   PetscFunctionReturn(0);
8505 }
8506