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