xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision abc8f43d1eab24ca0f213294b90f88e04b4bf102)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <petscblaslapack.h>
5 #include <petsc/private/sfimpl.h>
6 
7 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
8 
9 /* if range is true,  it returns B s.t. span{B} = range(A)
10    if range is false, it returns B s.t. range(B) _|_ range(A) */
11 #undef __FUNCT__
12 #define __FUNCT__ "MatDenseOrthogonalRangeOrComplement"
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 #undef __FUNCT__
89 #define __FUNCT__ "PCBDDCComputeNedelecChangeEdge"
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatGetSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatGetSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatGetSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 #undef __FUNCT__
156 #define __FUNCT__ "PCBDDCNedelecSupport"
157 PetscErrorCode PCBDDCNedelecSupport(PC pc)
158 {
159   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
160   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
161   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
162   Vec                    tvec;
163   PetscSF                sfv;
164   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
165   MPI_Comm               comm;
166   IS                     lned,primals,allprimals,nedfieldlocal;
167   IS                     *eedges,*extrows,*extcols,*alleedges;
168   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
169   PetscScalar            *vals,*work;
170   PetscReal              *rwork;
171   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
172   PetscInt               ne,nv,Lv,order,n,field;
173   PetscInt               n_neigh,*neigh,*n_shared,**shared;
174   PetscInt               i,j,extmem,cum,maxsize,nee;
175   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
176   PetscInt               *sfvleaves,*sfvroots;
177   PetscInt               *corners,*cedges;
178   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
179 #if defined(PETSC_USE_DEBUG)
180   PetscInt               *emarks;
181 #endif
182   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
183   PetscErrorCode         ierr;
184 
185   PetscFunctionBegin;
186   /* If the discrete gradient is defined for a subset of dofs and global is true,
187      it assumes G is given in global ordering for all the dofs.
188      Otherwise, the ordering is global for the Nedelec field */
189   order      = pcbddc->nedorder;
190   conforming = pcbddc->conforming;
191   field      = pcbddc->nedfield;
192   global     = pcbddc->nedglobal;
193   setprimal  = PETSC_FALSE;
194   print      = PETSC_FALSE;
195   singular   = PETSC_FALSE;
196 
197   /* Command line customization */
198   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
201   ierr = PetscOptionsInt ("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
202   /* print debug info TODO: to be removed */
203   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
204   ierr = PetscOptionsEnd();CHKERRQ(ierr);
205 
206   /* Return if there are no edges in the decomposition and the problem is not singular */
207   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
208   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
209   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
210   if (!singular) {
211     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
212     lrc[0] = PETSC_FALSE;
213     for (i=0;i<n;i++) {
214       if (PetscRealPart(vals[i]) > 2.) {
215         lrc[0] = PETSC_TRUE;
216         break;
217       }
218     }
219     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
220     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
221     if (!lrc[1]) PetscFunctionReturn(0);
222   }
223 
224   /* Get Nedelec field */
225   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
226   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
227   if (pcbddc->n_ISForDofsLocal && field >= 0) {
228     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
229     nedfieldlocal = pcbddc->ISForDofsLocal[field];
230     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
231   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
232     ne            = n;
233     nedfieldlocal = NULL;
234     global        = PETSC_TRUE;
235   } else if (field == PETSC_DECIDE) {
236     PetscInt rst,ren,*idx;
237 
238     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
239     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
240     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
241     for (i=rst;i<ren;i++) {
242       PetscInt nc;
243 
244       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
246       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
247     }
248     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
249     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
250     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
251     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
252     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
253   } else {
254     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
255   }
256 
257   /* Sanity checks */
258   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
259   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
260   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
261 
262   /* Just set primal dofs and return */
263   if (setprimal) {
264     IS       enedfieldlocal;
265     PetscInt *eidxs;
266 
267     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
268     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
269     if (nedfieldlocal) {
270       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
271       for (i=0,cum=0;i<ne;i++) {
272         if (PetscRealPart(vals[idxs[i]]) > 2.) {
273           eidxs[cum++] = idxs[i];
274         }
275       }
276       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
277     } else {
278       for (i=0,cum=0;i<ne;i++) {
279         if (PetscRealPart(vals[i]) > 2.) {
280           eidxs[cum++] = i;
281         }
282       }
283     }
284     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
285     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
286     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
287     ierr = PetscFree(eidxs);CHKERRQ(ierr);
288     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
289     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
290     PetscFunctionReturn(0);
291   }
292 
293   /* Compute some l2g maps */
294   if (nedfieldlocal) {
295     IS is;
296 
297     /* need to map from the local Nedelec field to local numbering */
298     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
300     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
301     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
302     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
303     if (global) {
304       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
305       el2g = al2g;
306     } else {
307       IS gis;
308 
309       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
310       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
311       ierr = ISDestroy(&gis);CHKERRQ(ierr);
312     }
313     ierr = ISDestroy(&is);CHKERRQ(ierr);
314   } else {
315     /* restore default */
316     pcbddc->nedfield = -1;
317     /* one ref for the destruction of al2g, one for el2g */
318     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
319     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
320     el2g = al2g;
321     fl2g = NULL;
322   }
323 
324   /* Start communication to drop connections for interior edges (for cc analysis only) */
325   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
326   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
327   if (nedfieldlocal) {
328     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
330     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
331   } else {
332     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
333   }
334   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
335   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
336 
337   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
338     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
339     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
340     if (global) {
341       PetscInt rst;
342 
343       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
344       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
345         if (matis->sf_rootdata[i] < 2) {
346           matis->sf_rootdata[cum++] = i + rst;
347         }
348       }
349       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
350       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
351     } else {
352       PetscInt *tbz;
353 
354       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
355       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
356       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
357       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       for (i=0,cum=0;i<ne;i++)
359         if (matis->sf_leafdata[idxs[i]] == 1)
360           tbz[cum++] = i;
361       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
362       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
363       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
364       ierr = PetscFree(tbz);CHKERRQ(ierr);
365     }
366   } else { /* we need the entire G to infer the nullspace */
367     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
368     G    = pcbddc->discretegradient;
369   }
370 
371   /* Extract subdomain relevant rows of G */
372   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
374   ierr = MatGetSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
375   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
376   ierr = ISDestroy(&lned);CHKERRQ(ierr);
377   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
378   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
379   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
380 
381   /* SF for nodal dofs communications */
382   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
383   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
384   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
386   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
388   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
389   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
390   i    = singular ? 2 : 1;
391   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
392 
393   /* Destroy temporary G created in MATIS format and modified G */
394   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
395   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
396   ierr = MatDestroy(&G);CHKERRQ(ierr);
397 
398   if (print) {
399     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
400     ierr = MatView(lG,NULL);CHKERRQ(ierr);
401   }
402 
403   /* Save lG for values insertion in change of basis */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
405 
406   /* Analyze the edge-nodes connections (duplicate lG) */
407   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
408   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
411   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
412   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
413   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
414   /* need to import the boundary specification to ensure the
415      proper detection of coarse edges' endpoints */
416   if (pcbddc->DirichletBoundariesLocal) {
417     IS is;
418 
419     if (fl2g) {
420       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
421     } else {
422       is = pcbddc->DirichletBoundariesLocal;
423     }
424     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
425     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
426     for (i=0;i<cum;i++) {
427       if (idxs[i] >= 0) {
428         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
429         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
430       }
431     }
432     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
433     if (fl2g) {
434       ierr = ISDestroy(&is);CHKERRQ(ierr);
435     }
436   }
437   if (pcbddc->NeumannBoundariesLocal) {
438     IS is;
439 
440     if (fl2g) {
441       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
442     } else {
443       is = pcbddc->NeumannBoundariesLocal;
444     }
445     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
446     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
447     for (i=0;i<cum;i++) {
448       if (idxs[i] >= 0) {
449         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
450       }
451     }
452     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
453     if (fl2g) {
454       ierr = ISDestroy(&is);CHKERRQ(ierr);
455     }
456   }
457 
458   /* Count neighs per dof */
459   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
460   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
461   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
462   for (i=1,cum=0;i<n_neigh;i++) {
463     cum += n_shared[i];
464     for (j=0;j<n_shared[i];j++) {
465       ecount[shared[i][j]]++;
466     }
467   }
468   if (ne) {
469     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
470   }
471   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
472   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
473   for (i=1;i<n_neigh;i++) {
474     for (j=0;j<n_shared[i];j++) {
475       PetscInt k = shared[i][j];
476       eneighs[k][ecount[k]] = neigh[i];
477       ecount[k]++;
478     }
479   }
480   for (i=0;i<ne;i++) {
481     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
482   }
483   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
484   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
485   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
486   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
487   for (i=1,cum=0;i<n_neigh;i++) {
488     cum += n_shared[i];
489     for (j=0;j<n_shared[i];j++) {
490       vcount[shared[i][j]]++;
491     }
492   }
493   if (nv) {
494     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
495   }
496   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
497   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
498   for (i=1;i<n_neigh;i++) {
499     for (j=0;j<n_shared[i];j++) {
500       PetscInt k = shared[i][j];
501       vneighs[k][vcount[k]] = neigh[i];
502       vcount[k]++;
503     }
504   }
505   for (i=0;i<nv;i++) {
506     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
507   }
508   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
509 
510   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
511      for proper detection of coarse edges' endpoints */
512   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
513   for (i=0;i<ne;i++) {
514     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
515       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
516     }
517   }
518   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
519   if (!conforming) {
520     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
521     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
522   }
523   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
525   cum  = 0;
526   for (i=0;i<ne;i++) {
527     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
528     if (!PetscBTLookup(btee,i)) {
529       marks[cum++] = i;
530       continue;
531     }
532     /* set badly connected edge dofs as primal */
533     if (!conforming) {
534       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
535         marks[cum++] = i;
536         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
537         for (j=ii[i];j<ii[i+1];j++) {
538           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
539         }
540       } else {
541         /* every edge dofs should be connected trough a certain number of nodal dofs
542            to other edge dofs belonging to coarse edges
543            - at most 2 endpoints
544            - order-1 interior nodal dofs
545            - no undefined nodal dofs (nconn < order)
546         */
547         PetscInt ends = 0,ints = 0, undef = 0;
548         for (j=ii[i];j<ii[i+1];j++) {
549           PetscInt v = jj[j],k;
550           PetscInt nconn = iit[v+1]-iit[v];
551           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
552           if (nconn > order) ends++;
553           else if (nconn == order) ints++;
554           else undef++;
555         }
556         if (undef || ends > 2 || ints != order -1) {
557           marks[cum++] = i;
558           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
559           for (j=ii[i];j<ii[i+1];j++) {
560             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
561           }
562         }
563       }
564     }
565     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
566     if (!order && ii[i+1] != ii[i]) {
567       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
568       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
569     }
570   }
571   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
572   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
573   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
574   if (!conforming) {
575     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
576     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
577   }
578   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
579 
580   /* identify splitpoints and corner candidates */
581   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
582   if (print) {
583     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
584     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
585     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
586     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
587   }
588   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
589   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
590   for (i=0;i<nv;i++) {
591     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
592     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
593     if (!order) { /* variable order */
594       PetscReal vorder = 0.;
595 
596       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
597       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
598       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
599       ord  = 1;
600     }
601 #if defined(PETSC_USE_DEBUG)
602     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
603 #endif
604     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
605       if (PetscBTLookup(btbd,jj[j])) {
606         bdir = PETSC_TRUE;
607         break;
608       }
609       if (vc != ecount[jj[j]]) {
610         sneighs = PETSC_FALSE;
611       } else {
612         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
613         for (k=0;k<vc;k++) {
614           if (vn[k] != en[k]) {
615             sneighs = PETSC_FALSE;
616             break;
617           }
618         }
619       }
620     }
621     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
622       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
623       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624     } else if (test == ord) {
625       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
626         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
627         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
628       } else {
629         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
630         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
631       }
632     }
633   }
634   ierr = PetscFree(ecount);CHKERRQ(ierr);
635   ierr = PetscFree(vcount);CHKERRQ(ierr);
636   if (ne) {
637     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
638   }
639   if (nv) {
640     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
641   }
642   ierr = PetscFree(eneighs);CHKERRQ(ierr);
643   ierr = PetscFree(vneighs);CHKERRQ(ierr);
644   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
645 
646   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
647   if (order != 1) {
648     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
649     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
650     for (i=0;i<nv;i++) {
651       if (PetscBTLookup(btvcand,i)) {
652         PetscBool found = PETSC_FALSE;
653         for (j=ii[i];j<ii[i+1] && !found;j++) {
654           PetscInt k,e = jj[j];
655           if (PetscBTLookup(bte,e)) continue;
656           for (k=iit[e];k<iit[e+1];k++) {
657             PetscInt v = jjt[k];
658             if (v != i && PetscBTLookup(btvcand,v)) {
659               found = PETSC_TRUE;
660               break;
661             }
662           }
663         }
664         if (!found) {
665           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
666           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
667         } else {
668           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
669         }
670       }
671     }
672     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
673   }
674   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
675   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
676   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
677 
678   /* Get the local G^T explicitly */
679   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
680   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
681   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
682 
683   /* Mark interior nodal dofs */
684   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
685   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
686   for (i=1;i<n_neigh;i++) {
687     for (j=0;j<n_shared[i];j++) {
688       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
689     }
690   }
691   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
692 
693   /* communicate corners and splitpoints */
694   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
695   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
696   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
697   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
698 
699   if (print) {
700     IS tbz;
701 
702     cum = 0;
703     for (i=0;i<nv;i++)
704       if (sfvleaves[i])
705         vmarks[cum++] = i;
706 
707     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
708     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
709     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
710     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
711   }
712 
713   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
714   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
715   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
716   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
717 
718   /* Zero rows of lGt corresponding to identified corners
719      and interior nodal dofs */
720   cum = 0;
721   for (i=0;i<nv;i++) {
722     if (sfvleaves[i]) {
723       vmarks[cum++] = i;
724       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
725     }
726     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
727   }
728   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
729   if (print) {
730     IS tbz;
731 
732     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
733     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
734     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
735     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
736   }
737   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
738   ierr = PetscFree(vmarks);CHKERRQ(ierr);
739   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
740   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
741 
742   /* Recompute G */
743   ierr = MatDestroy(&lG);CHKERRQ(ierr);
744   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
745   if (print) {
746     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
747     ierr = MatView(lG,NULL);CHKERRQ(ierr);
748     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
749     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
750   }
751 
752   /* Get primal dofs (if any) */
753   cum = 0;
754   for (i=0;i<ne;i++) {
755     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
756   }
757   if (fl2g) {
758     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
759   }
760   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
761   if (print) {
762     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
763     ierr = ISView(primals,NULL);CHKERRQ(ierr);
764   }
765   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
766   /* TODO: what if the user passed in some of them ?  */
767   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
768   ierr = ISDestroy(&primals);CHKERRQ(ierr);
769 
770   /* Compute edge connectivity */
771   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
772   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
773   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
774   if (fl2g) {
775     PetscBT   btf;
776     PetscInt  *iia,*jja,*iiu,*jju;
777     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
778 
779     /* create CSR for all local dofs */
780     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
781     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
782       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
783       iiu = pcbddc->mat_graph->xadj;
784       jju = pcbddc->mat_graph->adjncy;
785     } else if (pcbddc->use_local_adj) {
786       rest = PETSC_TRUE;
787       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
788     } else {
789       free   = PETSC_TRUE;
790       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
791       iiu[0] = 0;
792       for (i=0;i<n;i++) {
793         iiu[i+1] = i+1;
794         jju[i]   = -1;
795       }
796     }
797 
798     /* import sizes of CSR */
799     iia[0] = 0;
800     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
801 
802     /* overwrite entries corresponding to the Nedelec field */
803     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
804     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
805     for (i=0;i<ne;i++) {
806       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
807       iia[idxs[i]+1] = ii[i+1]-ii[i];
808     }
809 
810     /* iia in CSR */
811     for (i=0;i<n;i++) iia[i+1] += iia[i];
812 
813     /* jja in CSR */
814     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
815     for (i=0;i<n;i++)
816       if (!PetscBTLookup(btf,i))
817         for (j=0;j<iiu[i+1]-iiu[i];j++)
818           jja[iia[i]+j] = jju[iiu[i]+j];
819 
820     /* map edge dofs connectivity */
821     if (jj) {
822       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
823       for (i=0;i<ne;i++) {
824         PetscInt e = idxs[i];
825         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
826       }
827     }
828     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
829     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
830     if (rest) {
831       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
832     }
833     if (free) {
834       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
835     }
836     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
837   } else {
838     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
839   }
840 
841   /* Analyze interface for edge dofs */
842   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
843   pcbddc->mat_graph->twodim = PETSC_FALSE;
844 
845   /* Get coarse edges in the edge space */
846   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
847   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
848 
849   if (fl2g) {
850     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
851     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
852     for (i=0;i<nee;i++) {
853       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
854     }
855   } else {
856     eedges  = alleedges;
857     primals = allprimals;
858   }
859 
860   /* Mark fine edge dofs with their coarse edge id */
861   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
862   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
863   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
864   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
865   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
866   if (print) {
867     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
868     ierr = ISView(primals,NULL);CHKERRQ(ierr);
869   }
870 
871   maxsize = 0;
872   for (i=0;i<nee;i++) {
873     PetscInt size,mark = i+1;
874 
875     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
876     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     for (j=0;j<size;j++) marks[idxs[j]] = mark;
878     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
879     maxsize = PetscMax(maxsize,size);
880   }
881 
882   /* Find coarse edge endpoints */
883   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
884   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
885   for (i=0;i<nee;i++) {
886     PetscInt mark = i+1,size;
887 
888     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
889     if (!size && nedfieldlocal) continue;
890     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
891     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
892     if (print) {
893       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
894       ISView(eedges[i],NULL);
895     }
896     for (j=0;j<size;j++) {
897       PetscInt k, ee = idxs[j];
898       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
899       for (k=ii[ee];k<ii[ee+1];k++) {
900         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
901         if (PetscBTLookup(btv,jj[k])) {
902           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
903         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
904           PetscInt  k2;
905           PetscBool corner = PETSC_FALSE;
906           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
907             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
908             /* it's a corner if either is connected with an edge dof belonging to a different cc or
909                if the edge dof lie on the natural part of the boundary */
910             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
911               corner = PETSC_TRUE;
912               break;
913             }
914           }
915           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
916             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
917             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
918           } else {
919             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
920           }
921         }
922       }
923     }
924     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
925   }
926   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
927   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
928   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
929 
930   /* Reset marked primal dofs */
931   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
932   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
933   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
934   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
935 
936   /* Now use the initial lG */
937   ierr = MatDestroy(&lG);CHKERRQ(ierr);
938   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
939   lG   = lGinit;
940   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
941 
942   /* Compute extended cols indices */
943   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
944   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
945   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
946   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
947   i   *= maxsize;
948   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
949   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
950   eerr = PETSC_FALSE;
951   for (i=0;i<nee;i++) {
952     PetscInt size,found = 0;
953 
954     cum  = 0;
955     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
956     if (!size && nedfieldlocal) continue;
957     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
958     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
959     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
960     for (j=0;j<size;j++) {
961       PetscInt k,ee = idxs[j];
962       for (k=ii[ee];k<ii[ee+1];k++) {
963         PetscInt vv = jj[k];
964         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
965         else if (!PetscBTLookupSet(btvc,vv)) found++;
966       }
967     }
968     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
969     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
970     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
971     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
972     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
973     /* it may happen that endpoints are not defined at this point
974        if it is the case, mark this edge for a second pass */
975     if (cum != size -1 || found != 2) {
976       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
977       if (print) {
978         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
979         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
980         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
981         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
982       }
983       eerr = PETSC_TRUE;
984     }
985   }
986   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
987   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
988   if (done) {
989     PetscInt *newprimals;
990 
991     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
992     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
993     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
995     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
996     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
997     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
998     for (i=0;i<nee;i++) {
999       PetscBool has_candidates = PETSC_FALSE;
1000       if (PetscBTLookup(bter,i)) {
1001         PetscInt size,mark = i+1;
1002 
1003         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1004         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1005         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1006         for (j=0;j<size;j++) {
1007           PetscInt k,ee = idxs[j];
1008           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1009           for (k=ii[ee];k<ii[ee+1];k++) {
1010             /* set all candidates located on the edge as corners */
1011             if (PetscBTLookup(btvcand,jj[k])) {
1012               PetscInt k2,vv = jj[k];
1013               has_candidates = PETSC_TRUE;
1014               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1015               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1016               /* set all edge dofs connected to candidate as primals */
1017               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1018                 if (marks[jjt[k2]] == mark) {
1019                   PetscInt k3,ee2 = jjt[k2];
1020                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1021                   newprimals[cum++] = ee2;
1022                   /* finally set the new corners */
1023                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1024                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1025                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1026                   }
1027                 }
1028               }
1029             } else {
1030               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1031             }
1032           }
1033         }
1034         if (!has_candidates) { /* circular edge */
1035           PetscInt k, ee = idxs[0],*tmarks;
1036 
1037           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1038           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1039           for (k=ii[ee];k<ii[ee+1];k++) {
1040             PetscInt k2;
1041             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1042             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1043             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1044           }
1045           for (j=0;j<size;j++) {
1046             if (tmarks[idxs[j]] > 1) {
1047               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1048               newprimals[cum++] = idxs[j];
1049             }
1050           }
1051           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1052         }
1053         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       }
1055       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1056     }
1057     ierr = PetscFree(extcols);CHKERRQ(ierr);
1058     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1059     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1060     if (fl2g) {
1061       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1062       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1063       for (i=0;i<nee;i++) {
1064         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1065       }
1066       ierr = PetscFree(eedges);CHKERRQ(ierr);
1067     }
1068     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1069     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1070     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1071     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1072     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1073     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1074     pcbddc->mat_graph->twodim = PETSC_FALSE;
1075     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1076     if (fl2g) {
1077       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1078       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1079       for (i=0;i<nee;i++) {
1080         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1081       }
1082     } else {
1083       eedges  = alleedges;
1084       primals = allprimals;
1085     }
1086     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1087 
1088     /* Mark again */
1089     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1090     for (i=0;i<nee;i++) {
1091       PetscInt size,mark = i+1;
1092 
1093       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1094       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1096       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1097     }
1098     if (print) {
1099       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1100       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1101     }
1102 
1103     /* Recompute extended cols */
1104     eerr = PETSC_FALSE;
1105     for (i=0;i<nee;i++) {
1106       PetscInt size;
1107 
1108       cum  = 0;
1109       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1110       if (!size && nedfieldlocal) continue;
1111       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1112       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1113       for (j=0;j<size;j++) {
1114         PetscInt k,ee = idxs[j];
1115         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1116       }
1117       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1118       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1119       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1120       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1121       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1122       if (cum != size -1) {
1123         if (print) {
1124           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1126           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1127           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1128         }
1129         eerr = PETSC_TRUE;
1130       }
1131     }
1132   }
1133   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1135   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1136   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1137   /* an error should not occur at this point */
1138   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1139 
1140   /* Check the number of endpoints */
1141   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1142   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1143   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1144   for (i=0;i<nee;i++) {
1145     PetscInt size, found = 0, gc[2];
1146 
1147     /* init with defaults */
1148     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1149     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1150     if (!size && nedfieldlocal) continue;
1151     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1152     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1153     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1154     for (j=0;j<size;j++) {
1155       PetscInt k,ee = idxs[j];
1156       for (k=ii[ee];k<ii[ee+1];k++) {
1157         PetscInt vv = jj[k];
1158         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1159           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1160           corners[i*2+found++] = vv;
1161         }
1162       }
1163     }
1164     if (found != 2) {
1165       PetscInt e;
1166       if (fl2g) {
1167         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1168       } else {
1169         e = idxs[0];
1170       }
1171       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1172     }
1173 
1174     /* get primal dof index on this coarse edge */
1175     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1176     if (gc[0] > gc[1]) {
1177       PetscInt swap  = corners[2*i];
1178       corners[2*i]   = corners[2*i+1];
1179       corners[2*i+1] = swap;
1180     }
1181     cedges[i] = idxs[size-1];
1182     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1183     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1184   }
1185   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1187 
1188 #if defined(PETSC_USE_DEBUG)
1189   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1190      not interfere with neighbouring coarse edges */
1191   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1192   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1193   for (i=0;i<nv;i++) {
1194     PetscInt emax = 0,eemax = 0;
1195 
1196     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1197     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1198     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1199     for (j=1;j<nee+1;j++) {
1200       if (emax < emarks[j]) {
1201         emax = emarks[j];
1202         eemax = j;
1203       }
1204     }
1205     /* not relevant for edges */
1206     if (!eemax) continue;
1207 
1208     for (j=ii[i];j<ii[i+1];j++) {
1209       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1210         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1211       }
1212     }
1213   }
1214   ierr = PetscFree(emarks);CHKERRQ(ierr);
1215   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216 #endif
1217 
1218   /* Compute extended rows indices for edge blocks of the change of basis */
1219   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1220   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1221   extmem *= maxsize;
1222   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1223   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1224   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1225   for (i=0;i<nv;i++) {
1226     PetscInt mark = 0,size,start;
1227 
1228     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1229     for (j=ii[i];j<ii[i+1];j++)
1230       if (marks[jj[j]] && !mark)
1231         mark = marks[jj[j]];
1232 
1233     /* not relevant */
1234     if (!mark) continue;
1235 
1236     /* import extended row */
1237     mark--;
1238     start = mark*extmem+extrowcum[mark];
1239     size = ii[i+1]-ii[i];
1240     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1241     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1242     extrowcum[mark] += size;
1243   }
1244   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1245   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1246   ierr = PetscFree(marks);CHKERRQ(ierr);
1247 
1248   /* Compress extrows */
1249   cum  = 0;
1250   for (i=0;i<nee;i++) {
1251     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1252     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1253     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1254     cum  = PetscMax(cum,size);
1255   }
1256   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1257   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1258   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1259 
1260   /* Workspace for lapack inner calls and VecSetValues */
1261   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1262 
1263   /* Create change of basis matrix (preallocation can be improved) */
1264   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1265   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1266                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1267   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1268   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1269   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1270   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1271   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1272   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1273   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1274 
1275   /* Defaults to identity */
1276   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1277   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1278   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1279   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1280 
1281   /* Create discrete gradient for the coarser level if needed */
1282   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1283   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1284   if (pcbddc->current_level < pcbddc->max_levels) {
1285     ISLocalToGlobalMapping cel2g,cvl2g;
1286     IS                     wis,gwis;
1287     PetscInt               cnv,cne;
1288 
1289     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1290     if (fl2g) {
1291       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1292     } else {
1293       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1294       pcbddc->nedclocal = wis;
1295     }
1296     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1298     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1299     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1300     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1302 
1303     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1304     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1306     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1307     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1308     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1309     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1310 
1311     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1312     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1313     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1314     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1315     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1316     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1317     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1318     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1319   }
1320   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1321 
1322 #if defined(PRINT_GDET)
1323   inc = 0;
1324   lev = pcbddc->current_level;
1325 #endif
1326 
1327   /* Insert values in the change of basis matrix */
1328   for (i=0;i<nee;i++) {
1329     Mat         Gins = NULL, GKins = NULL;
1330     IS          cornersis = NULL;
1331     PetscScalar cvals[2];
1332 
1333     if (pcbddc->nedcG) {
1334       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1335     }
1336     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1337     if (Gins && GKins) {
1338       PetscScalar    *data;
1339       const PetscInt *rows,*cols;
1340       PetscInt       nrh,nch,nrc,ncc;
1341 
1342       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1343       /* H1 */
1344       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1345       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1346       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1348       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1349       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1350       /* complement */
1351       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1352       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1353       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1354       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1355       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1356       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1357       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1358 
1359       /* coarse discrete gradient */
1360       if (pcbddc->nedcG) {
1361         PetscInt cols[2];
1362 
1363         cols[0] = 2*i;
1364         cols[1] = 2*i+1;
1365         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1366       }
1367       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1368     }
1369     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1370     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1371     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1372     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1373     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1376 
1377   /* Start assembling */
1378   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   if (pcbddc->nedcG) {
1380     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1381   }
1382 
1383   /* Free */
1384   if (fl2g) {
1385     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1386     for (i=0;i<nee;i++) {
1387       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1388     }
1389     ierr = PetscFree(eedges);CHKERRQ(ierr);
1390   }
1391 
1392   /* hack mat_graph with primal dofs on the coarse edges */
1393   {
1394     PCBDDCGraph graph   = pcbddc->mat_graph;
1395     PetscInt    *oqueue = graph->queue;
1396     PetscInt    *ocptr  = graph->cptr;
1397     PetscInt    ncc,*idxs;
1398 
1399     /* find first primal edge */
1400     if (pcbddc->nedclocal) {
1401       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1402     } else {
1403       if (fl2g) {
1404         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1405       }
1406       idxs = cedges;
1407     }
1408     cum = 0;
1409     while (cum < nee && cedges[cum] < 0) cum++;
1410 
1411     /* adapt connected components */
1412     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1413     graph->cptr[0] = 0;
1414     for (i=0,ncc=0;i<graph->ncc;i++) {
1415       PetscInt lc = ocptr[i+1]-ocptr[i];
1416       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1417         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1418         graph->queue[graph->cptr[ncc]] = cedges[cum];
1419         ncc++;
1420         lc--;
1421         cum++;
1422         while (cum < nee && cedges[cum] < 0) cum++;
1423       }
1424       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1425       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1426       ncc++;
1427     }
1428     graph->ncc = ncc;
1429     if (pcbddc->nedclocal) {
1430       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1431     }
1432     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1433   }
1434   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1435   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1436   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1437   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1438 
1439   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1440   ierr = PetscFree(extrow);CHKERRQ(ierr);
1441   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1442   ierr = PetscFree(corners);CHKERRQ(ierr);
1443   ierr = PetscFree(cedges);CHKERRQ(ierr);
1444   ierr = PetscFree(extrows);CHKERRQ(ierr);
1445   ierr = PetscFree(extcols);CHKERRQ(ierr);
1446   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1447 
1448   /* Complete assembling */
1449   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450   if (pcbddc->nedcG) {
1451     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1452 #if 0
1453     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1454     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1455 #endif
1456   }
1457 
1458   /* set change of basis */
1459   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1460   ierr = MatDestroy(&T);CHKERRQ(ierr);
1461 
1462   PetscFunctionReturn(0);
1463 }
1464 
1465 /* the near-null space of BDDC carries information on quadrature weights,
1466    and these can be collinear -> so cheat with MatNullSpaceCreate
1467    and create a suitable set of basis vectors first */
1468 #undef __FUNCT__
1469 #define __FUNCT__ "PCBDDCNullSpaceCreate"
1470 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1471 {
1472   PetscErrorCode ierr;
1473   PetscInt       i;
1474 
1475   PetscFunctionBegin;
1476   for (i=0;i<nvecs;i++) {
1477     PetscInt first,last;
1478 
1479     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1480     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1481     if (i>=first && i < last) {
1482       PetscScalar *data;
1483       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1484       if (!has_const) {
1485         data[i-first] = 1.;
1486       } else {
1487         data[2*i-first] = 1./PetscSqrtReal(2.);
1488         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1489       }
1490       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1491     }
1492     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1493   }
1494   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1495   for (i=0;i<nvecs;i++) { /* reset vectors */
1496     PetscInt first,last;
1497     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1498     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1499     if (i>=first && i < last) {
1500       PetscScalar *data;
1501       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1502       if (!has_const) {
1503         data[i-first] = 0.;
1504       } else {
1505         data[2*i-first] = 0.;
1506         data[2*i-first+1] = 0.;
1507       }
1508       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1509     }
1510     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1511     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1512   }
1513   PetscFunctionReturn(0);
1514 }
1515 
1516 #undef __FUNCT__
1517 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
1518 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1519 {
1520   Mat                    loc_divudotp;
1521   Vec                    p,v,vins,quad_vec,*quad_vecs;
1522   ISLocalToGlobalMapping map;
1523   IS                     *faces,*edges;
1524   PetscScalar            *vals;
1525   const PetscScalar      *array;
1526   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1527   PetscMPIInt            rank;
1528   PetscErrorCode         ierr;
1529 
1530   PetscFunctionBegin;
1531   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1532   if (graph->twodim) {
1533     lmaxneighs = 2;
1534   } else {
1535     lmaxneighs = 1;
1536     for (i=0;i<ne;i++) {
1537       const PetscInt *idxs;
1538       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1539       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1540       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1541     }
1542     lmaxneighs++; /* graph count does not include self */
1543   }
1544   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1545   maxsize = 0;
1546   for (i=0;i<ne;i++) {
1547     PetscInt nn;
1548     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1549     maxsize = PetscMax(maxsize,nn);
1550   }
1551   for (i=0;i<nf;i++) {
1552     PetscInt nn;
1553     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1554     maxsize = PetscMax(maxsize,nn);
1555   }
1556   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1557   /* create vectors to hold quadrature weights */
1558   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1559   if (!transpose) {
1560     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1561   } else {
1562     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1563   }
1564   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1565   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1566   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1567   for (i=0;i<maxneighs;i++) {
1568     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1569     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1570   }
1571 
1572   /* compute local quad vec */
1573   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1574   if (!transpose) {
1575     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1576   } else {
1577     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1578   }
1579   ierr = VecSet(p,1.);CHKERRQ(ierr);
1580   if (!transpose) {
1581     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1582   } else {
1583     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1584   }
1585   if (vl2l) {
1586     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 #undef __FUNCT__
1641 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
1642 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1643 {
1644   PetscErrorCode ierr;
1645   Vec            local,global;
1646   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1647   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1648 
1649   PetscFunctionBegin;
1650   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1651   /* need to convert from global to local topology information and remove references to information in global ordering */
1652   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1653   if (pcbddc->user_provided_isfordofs) {
1654     if (pcbddc->n_ISForDofs) {
1655       PetscInt i;
1656       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1657       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1658         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1659         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1660       }
1661       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1662       pcbddc->n_ISForDofs = 0;
1663       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1664     }
1665   } else {
1666     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
1667       PetscInt i, n = matis->A->rmap->n;
1668       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1669       if (i > 1) {
1670         pcbddc->n_ISForDofsLocal = i;
1671         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1672         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1673           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1674         }
1675       }
1676     } else {
1677       PetscInt i;
1678       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1679         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680       }
1681     }
1682   }
1683 
1684   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1685     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1686   } else if (pcbddc->DirichletBoundariesLocal) {
1687     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1688   }
1689   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1690     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1691   } else if (pcbddc->NeumannBoundariesLocal) {
1692     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1693   }
1694   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1695     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1696   }
1697   ierr = VecDestroy(&global);CHKERRQ(ierr);
1698   ierr = VecDestroy(&local);CHKERRQ(ierr);
1699 
1700   PetscFunctionReturn(0);
1701 }
1702 
1703 #undef __FUNCT__
1704 #define __FUNCT__ "PCBDDCConsistencyCheckIS"
1705 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1706 {
1707   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1708   PetscErrorCode  ierr;
1709   IS              nis;
1710   const PetscInt  *idxs;
1711   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1712   PetscBool       *ld;
1713 
1714   PetscFunctionBegin;
1715   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1716   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1717   if (mop == MPI_LAND) {
1718     /* init rootdata with true */
1719     ld   = (PetscBool*) matis->sf_rootdata;
1720     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1721   } else {
1722     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1723   }
1724   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1725   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1726   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1727   ld   = (PetscBool*) matis->sf_leafdata;
1728   for (i=0;i<nd;i++)
1729     if (-1 < idxs[i] && idxs[i] < n)
1730       ld[idxs[i]] = PETSC_TRUE;
1731   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1732   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1733   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1734   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1735   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1736   if (mop == MPI_LAND) {
1737     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1738   } else {
1739     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1740   }
1741   for (i=0,nnd=0;i<n;i++)
1742     if (ld[i])
1743       nidxs[nnd++] = i;
1744   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1745   ierr = ISDestroy(is);CHKERRQ(ierr);
1746   *is  = nis;
1747   PetscFunctionReturn(0);
1748 }
1749 
1750 #undef __FUNCT__
1751 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
1752 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1753 {
1754   PC_IS             *pcis = (PC_IS*)(pc->data);
1755   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1756   PetscErrorCode    ierr;
1757 
1758   PetscFunctionBegin;
1759   if (!pcbddc->benign_have_null) {
1760     PetscFunctionReturn(0);
1761   }
1762   if (pcbddc->ChangeOfBasisMatrix) {
1763     Vec swap;
1764 
1765     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1766     swap = pcbddc->work_change;
1767     pcbddc->work_change = r;
1768     r = swap;
1769   }
1770   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1771   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1772   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1773   ierr = VecSet(z,0.);CHKERRQ(ierr);
1774   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1775   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1776   if (pcbddc->ChangeOfBasisMatrix) {
1777     pcbddc->work_change = r;
1778     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1779     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1780   }
1781   PetscFunctionReturn(0);
1782 }
1783 
1784 #undef __FUNCT__
1785 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
1786 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1787 {
1788   PCBDDCBenignMatMult_ctx ctx;
1789   PetscErrorCode          ierr;
1790   PetscBool               apply_right,apply_left,reset_x;
1791 
1792   PetscFunctionBegin;
1793   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1794   if (transpose) {
1795     apply_right = ctx->apply_left;
1796     apply_left = ctx->apply_right;
1797   } else {
1798     apply_right = ctx->apply_right;
1799     apply_left = ctx->apply_left;
1800   }
1801   reset_x = PETSC_FALSE;
1802   if (apply_right) {
1803     const PetscScalar *ax;
1804     PetscInt          nl,i;
1805 
1806     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1807     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1808     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1809     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1810     for (i=0;i<ctx->benign_n;i++) {
1811       PetscScalar    sum,val;
1812       const PetscInt *idxs;
1813       PetscInt       nz,j;
1814       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1815       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1816       sum = 0.;
1817       if (ctx->apply_p0) {
1818         val = ctx->work[idxs[nz-1]];
1819         for (j=0;j<nz-1;j++) {
1820           sum += ctx->work[idxs[j]];
1821           ctx->work[idxs[j]] += val;
1822         }
1823       } else {
1824         for (j=0;j<nz-1;j++) {
1825           sum += ctx->work[idxs[j]];
1826         }
1827       }
1828       ctx->work[idxs[nz-1]] -= sum;
1829       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1830     }
1831     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1832     reset_x = PETSC_TRUE;
1833   }
1834   if (transpose) {
1835     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1836   } else {
1837     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1838   }
1839   if (reset_x) {
1840     ierr = VecResetArray(x);CHKERRQ(ierr);
1841   }
1842   if (apply_left) {
1843     PetscScalar *ay;
1844     PetscInt    i;
1845 
1846     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1847     for (i=0;i<ctx->benign_n;i++) {
1848       PetscScalar    sum,val;
1849       const PetscInt *idxs;
1850       PetscInt       nz,j;
1851       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1852       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1853       val = -ay[idxs[nz-1]];
1854       if (ctx->apply_p0) {
1855         sum = 0.;
1856         for (j=0;j<nz-1;j++) {
1857           sum += ay[idxs[j]];
1858           ay[idxs[j]] += val;
1859         }
1860         ay[idxs[nz-1]] += sum;
1861       } else {
1862         for (j=0;j<nz-1;j++) {
1863           ay[idxs[j]] += val;
1864         }
1865         ay[idxs[nz-1]] = 0.;
1866       }
1867       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1868     }
1869     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1870   }
1871   PetscFunctionReturn(0);
1872 }
1873 
1874 #undef __FUNCT__
1875 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
1876 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1877 {
1878   PetscErrorCode ierr;
1879 
1880   PetscFunctionBegin;
1881   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1882   PetscFunctionReturn(0);
1883 }
1884 
1885 #undef __FUNCT__
1886 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
1887 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1888 {
1889   PetscErrorCode ierr;
1890 
1891   PetscFunctionBegin;
1892   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1893   PetscFunctionReturn(0);
1894 }
1895 
1896 #undef __FUNCT__
1897 #define __FUNCT__ "PCBDDCBenignShellMat"
1898 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1899 {
1900   PC_IS                   *pcis = (PC_IS*)pc->data;
1901   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1902   PCBDDCBenignMatMult_ctx ctx;
1903   PetscErrorCode          ierr;
1904 
1905   PetscFunctionBegin;
1906   if (!restore) {
1907     Mat                A_IB,A_BI;
1908     PetscScalar        *work;
1909     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1910 
1911     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1912     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1913     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1914     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1915     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1916     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1917     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1918     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1919     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1920     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1921     ctx->apply_left = PETSC_TRUE;
1922     ctx->apply_right = PETSC_FALSE;
1923     ctx->apply_p0 = PETSC_FALSE;
1924     ctx->benign_n = pcbddc->benign_n;
1925     if (reuse) {
1926       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1927       ctx->free = PETSC_FALSE;
1928     } else { /* TODO: could be optimized for successive solves */
1929       ISLocalToGlobalMapping N_to_D;
1930       PetscInt               i;
1931 
1932       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1933       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1934       for (i=0;i<pcbddc->benign_n;i++) {
1935         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1936       }
1937       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1938       ctx->free = PETSC_TRUE;
1939     }
1940     ctx->A = pcis->A_IB;
1941     ctx->work = work;
1942     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1943     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1944     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1945     pcis->A_IB = A_IB;
1946 
1947     /* A_BI as A_IB^T */
1948     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1949     pcbddc->benign_original_mat = pcis->A_BI;
1950     pcis->A_BI = A_BI;
1951   } else {
1952     if (!pcbddc->benign_original_mat) {
1953       PetscFunctionReturn(0);
1954     }
1955     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1956     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1957     pcis->A_IB = ctx->A;
1958     ctx->A = NULL;
1959     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1960     pcis->A_BI = pcbddc->benign_original_mat;
1961     pcbddc->benign_original_mat = NULL;
1962     if (ctx->free) {
1963       PetscInt i;
1964       for (i=0;i<ctx->benign_n;i++) {
1965         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1966       }
1967       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1968     }
1969     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1970     ierr = PetscFree(ctx);CHKERRQ(ierr);
1971   }
1972   PetscFunctionReturn(0);
1973 }
1974 
1975 /* used just in bddc debug mode */
1976 #undef __FUNCT__
1977 #define __FUNCT__ "PCBDDCBenignProject"
1978 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1979 {
1980   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1981   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1982   Mat            An;
1983   PetscErrorCode ierr;
1984 
1985   PetscFunctionBegin;
1986   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1987   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1988   if (is1) {
1989     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1990     ierr = MatDestroy(&An);CHKERRQ(ierr);
1991   } else {
1992     *B = An;
1993   }
1994   PetscFunctionReturn(0);
1995 }
1996 
1997 /* TODO: add reuse flag */
1998 #undef __FUNCT__
1999 #define __FUNCT__ "MatSeqAIJCompress"
2000 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2001 {
2002   Mat            Bt;
2003   PetscScalar    *a,*bdata;
2004   const PetscInt *ii,*ij;
2005   PetscInt       m,n,i,nnz,*bii,*bij;
2006   PetscBool      flg_row;
2007   PetscErrorCode ierr;
2008 
2009   PetscFunctionBegin;
2010   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2011   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2012   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2013   nnz = n;
2014   for (i=0;i<ii[n];i++) {
2015     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2016   }
2017   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2018   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2019   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2020   nnz = 0;
2021   bii[0] = 0;
2022   for (i=0;i<n;i++) {
2023     PetscInt j;
2024     for (j=ii[i];j<ii[i+1];j++) {
2025       PetscScalar entry = a[j];
2026       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2027         bij[nnz] = ij[j];
2028         bdata[nnz] = entry;
2029         nnz++;
2030       }
2031     }
2032     bii[i+1] = nnz;
2033   }
2034   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2035   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2036   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2037   {
2038     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2039     b->free_a = PETSC_TRUE;
2040     b->free_ij = PETSC_TRUE;
2041   }
2042   *B = Bt;
2043   PetscFunctionReturn(0);
2044 }
2045 
2046 #undef __FUNCT__
2047 #define __FUNCT__ "MatDetectDisconnectedComponents"
2048 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
2049 {
2050   Mat                    B;
2051   IS                     is_dummy,*cc_n;
2052   ISLocalToGlobalMapping l2gmap_dummy;
2053   PCBDDCGraph            graph;
2054   PetscInt               i,n;
2055   PetscInt               *xadj,*adjncy;
2056   PetscInt               *xadj_filtered,*adjncy_filtered;
2057   PetscBool              flg_row,isseqaij;
2058   PetscErrorCode         ierr;
2059 
2060   PetscFunctionBegin;
2061   if (!A->rmap->N || !A->cmap->N) {
2062     *ncc = 0;
2063     *cc = NULL;
2064     PetscFunctionReturn(0);
2065   }
2066   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2067   if (!isseqaij && filter) {
2068     PetscBool isseqdense;
2069 
2070     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2071     if (!isseqdense) {
2072       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2073     } else { /* TODO: rectangular case and LDA */
2074       PetscScalar *array;
2075       PetscReal   chop=1.e-6;
2076 
2077       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2078       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2079       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2080       for (i=0;i<n;i++) {
2081         PetscInt j;
2082         for (j=i+1;j<n;j++) {
2083           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2084           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2085           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2086         }
2087       }
2088       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2089       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2090     }
2091   } else {
2092     B = A;
2093   }
2094   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2095 
2096   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2097   if (filter) {
2098     PetscScalar *data;
2099     PetscInt    j,cum;
2100 
2101     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2102     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2103     cum = 0;
2104     for (i=0;i<n;i++) {
2105       PetscInt t;
2106 
2107       for (j=xadj[i];j<xadj[i+1];j++) {
2108         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2109           continue;
2110         }
2111         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2112       }
2113       t = xadj_filtered[i];
2114       xadj_filtered[i] = cum;
2115       cum += t;
2116     }
2117     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2118   } else {
2119     xadj_filtered = NULL;
2120     adjncy_filtered = NULL;
2121   }
2122 
2123   /* compute local connected components using PCBDDCGraph */
2124   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2125   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2126   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2127   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2128   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2129   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2130   if (xadj_filtered) {
2131     graph->xadj = xadj_filtered;
2132     graph->adjncy = adjncy_filtered;
2133   } else {
2134     graph->xadj = xadj;
2135     graph->adjncy = adjncy;
2136   }
2137   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2138   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2139   /* partial clean up */
2140   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2141   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2142   if (A != B) {
2143     ierr = MatDestroy(&B);CHKERRQ(ierr);
2144   }
2145 
2146   /* get back data */
2147   if (ncc) *ncc = graph->ncc;
2148   if (cc) {
2149     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2150     for (i=0;i<graph->ncc;i++) {
2151       ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2152     }
2153     *cc = cc_n;
2154   }
2155   /* clean up graph */
2156   graph->xadj = 0;
2157   graph->adjncy = 0;
2158   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2159   PetscFunctionReturn(0);
2160 }
2161 
2162 #undef __FUNCT__
2163 #define __FUNCT__ "PCBDDCBenignCheck"
2164 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2165 {
2166   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2167   PC_IS*         pcis = (PC_IS*)(pc->data);
2168   IS             dirIS = NULL;
2169   PetscInt       i;
2170   PetscErrorCode ierr;
2171 
2172   PetscFunctionBegin;
2173   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2174   if (zerodiag) {
2175     Mat            A;
2176     Vec            vec3_N;
2177     PetscScalar    *vals;
2178     const PetscInt *idxs;
2179     PetscInt       nz,*count;
2180 
2181     /* p0 */
2182     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2183     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2184     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2185     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2186     for (i=0;i<nz;i++) vals[i] = 1.;
2187     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2188     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2189     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2190     /* v_I */
2191     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2192     for (i=0;i<nz;i++) vals[i] = 0.;
2193     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2194     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2195     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2196     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2197     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2198     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2199     if (dirIS) {
2200       PetscInt n;
2201 
2202       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2203       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2204       for (i=0;i<n;i++) vals[i] = 0.;
2205       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2206       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2207     }
2208     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2209     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2210     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2211     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2212     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2213     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2214     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2215     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2216     ierr = PetscFree(vals);CHKERRQ(ierr);
2217     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2218 
2219     /* there should not be any pressure dofs lying on the interface */
2220     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2221     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2222     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2223     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2224     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2225     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2226     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2227     ierr = PetscFree(count);CHKERRQ(ierr);
2228   }
2229   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2230 
2231   /* check PCBDDCBenignGetOrSetP0 */
2232   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2233   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2234   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2235   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2236   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2237   for (i=0;i<pcbddc->benign_n;i++) {
2238     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2239     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2240   }
2241   PetscFunctionReturn(0);
2242 }
2243 
2244 #undef __FUNCT__
2245 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
2246 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2247 {
2248   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2249   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2250   PetscInt       nz,n;
2251   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2252   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2253   PetscErrorCode ierr;
2254 
2255   PetscFunctionBegin;
2256   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2257   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2258   for (n=0;n<pcbddc->benign_n;n++) {
2259     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2260   }
2261   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2262   pcbddc->benign_n = 0;
2263 
2264   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2265      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2266      Checks if all the pressure dofs in each subdomain have a zero diagonal
2267      If not, a change of basis on pressures is not needed
2268      since the local Schur complements are already SPD
2269   */
2270   has_null_pressures = PETSC_TRUE;
2271   have_null = PETSC_TRUE;
2272   if (pcbddc->n_ISForDofsLocal) {
2273     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2274 
2275     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2276     ierr = PetscOptionsInt ("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2277     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2278     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2279     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2280     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2281     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2282     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2283     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2284     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2285     if (!sorted) {
2286       ierr = ISSort(pressures);CHKERRQ(ierr);
2287     }
2288   } else {
2289     pressures = NULL;
2290   }
2291   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2292   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2293   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2294   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2295   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2296   if (!sorted) {
2297     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2298   }
2299   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2300   zerodiag_save = zerodiag;
2301   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2302   if (!nz) {
2303     if (n) have_null = PETSC_FALSE;
2304     has_null_pressures = PETSC_FALSE;
2305     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2306   }
2307   recompute_zerodiag = PETSC_FALSE;
2308   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2309   zerodiag_subs    = NULL;
2310   pcbddc->benign_n = 0;
2311   n_interior_dofs  = 0;
2312   interior_dofs    = NULL;
2313   nneu             = 0;
2314   if (pcbddc->NeumannBoundariesLocal) {
2315     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2316   }
2317   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2318   if (checkb) { /* need to compute interior nodes */
2319     PetscInt n,i,j;
2320     PetscInt n_neigh,*neigh,*n_shared,**shared;
2321     PetscInt *iwork;
2322 
2323     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2324     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2325     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2326     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2327     for (i=1;i<n_neigh;i++)
2328       for (j=0;j<n_shared[i];j++)
2329           iwork[shared[i][j]] += 1;
2330     for (i=0;i<n;i++)
2331       if (!iwork[i])
2332         interior_dofs[n_interior_dofs++] = i;
2333     ierr = PetscFree(iwork);CHKERRQ(ierr);
2334     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2335   }
2336   if (has_null_pressures) {
2337     IS             *subs;
2338     PetscInt       nsubs,i,j,nl;
2339     const PetscInt *idxs;
2340     PetscScalar    *array;
2341     Vec            *work;
2342     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2343 
2344     subs  = pcbddc->local_subs;
2345     nsubs = pcbddc->n_local_subs;
2346     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2347     if (checkb) {
2348       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2349       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2350       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2351       /* work[0] = 1_p */
2352       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2353       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2354       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2355       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2356       /* work[0] = 1_v */
2357       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2358       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2359       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2360       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2361       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2362     }
2363     if (nsubs > 1) {
2364       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2365       for (i=0;i<nsubs;i++) {
2366         ISLocalToGlobalMapping l2g;
2367         IS                     t_zerodiag_subs;
2368         PetscInt               nl;
2369 
2370         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2371         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2372         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2373         if (nl) {
2374           PetscBool valid = PETSC_TRUE;
2375 
2376           if (checkb) {
2377             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2378             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2379             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2380             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2381             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2382             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2383             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2384             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2385             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2386             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2387             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2388             for (j=0;j<n_interior_dofs;j++) {
2389               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2390                 valid = PETSC_FALSE;
2391                 break;
2392               }
2393             }
2394             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2395           }
2396           if (valid && nneu) {
2397             const PetscInt *idxs;
2398             PetscInt       nzb;
2399 
2400             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2401             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2402             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2403             if (nzb) valid = PETSC_FALSE;
2404           }
2405           if (valid && pressures) {
2406             IS t_pressure_subs;
2407             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2408             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2409             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2410           }
2411           if (valid) {
2412             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2413             pcbddc->benign_n++;
2414           } else {
2415             recompute_zerodiag = PETSC_TRUE;
2416           }
2417         }
2418         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2419         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2420       }
2421     } else { /* there's just one subdomain (or zero if they have not been detected */
2422       PetscBool valid = PETSC_TRUE;
2423 
2424       if (nneu) valid = PETSC_FALSE;
2425       if (valid && pressures) {
2426         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2427       }
2428       if (valid && checkb) {
2429         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2430         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2431         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2432         for (j=0;j<n_interior_dofs;j++) {
2433           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2434             valid = PETSC_FALSE;
2435             break;
2436           }
2437         }
2438         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2439       }
2440       if (valid) {
2441         pcbddc->benign_n = 1;
2442         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2443         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2444         zerodiag_subs[0] = zerodiag;
2445       }
2446     }
2447     if (checkb) {
2448       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2449     }
2450   }
2451   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2452 
2453   if (!pcbddc->benign_n) {
2454     PetscInt n;
2455 
2456     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2457     recompute_zerodiag = PETSC_FALSE;
2458     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2459     if (n) {
2460       has_null_pressures = PETSC_FALSE;
2461       have_null = PETSC_FALSE;
2462     }
2463   }
2464 
2465   /* final check for null pressures */
2466   if (zerodiag && pressures) {
2467     PetscInt nz,np;
2468     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2469     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2470     if (nz != np) have_null = PETSC_FALSE;
2471   }
2472 
2473   if (recompute_zerodiag) {
2474     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2475     if (pcbddc->benign_n == 1) {
2476       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2477       zerodiag = zerodiag_subs[0];
2478     } else {
2479       PetscInt i,nzn,*new_idxs;
2480 
2481       nzn = 0;
2482       for (i=0;i<pcbddc->benign_n;i++) {
2483         PetscInt ns;
2484         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2485         nzn += ns;
2486       }
2487       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2488       nzn = 0;
2489       for (i=0;i<pcbddc->benign_n;i++) {
2490         PetscInt ns,*idxs;
2491         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2492         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2493         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2494         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2495         nzn += ns;
2496       }
2497       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2498       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2499     }
2500     have_null = PETSC_FALSE;
2501   }
2502 
2503   /* Prepare matrix to compute no-net-flux */
2504   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2505     Mat                    A,loc_divudotp;
2506     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2507     IS                     row,col,isused = NULL;
2508     PetscInt               M,N,n,st,n_isused;
2509 
2510     if (pressures) {
2511       isused = pressures;
2512     } else {
2513       isused = zerodiag_save;
2514     }
2515     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2516     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2517     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2518     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2519     n_isused = 0;
2520     if (isused) {
2521       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2522     }
2523     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2524     st = st-n_isused;
2525     if (n) {
2526       const PetscInt *gidxs;
2527 
2528       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2529       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2530       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2531       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2532       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2533       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2534     } else {
2535       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2536       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2537       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2538     }
2539     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2540     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2541     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2542     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2543     ierr = ISDestroy(&row);CHKERRQ(ierr);
2544     ierr = ISDestroy(&col);CHKERRQ(ierr);
2545     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2546     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2547     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2548     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2549     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2550     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2551     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2552     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2553     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2554     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2555   }
2556   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2557 
2558   /* change of basis and p0 dofs */
2559   if (has_null_pressures) {
2560     IS             zerodiagc;
2561     const PetscInt *idxs,*idxsc;
2562     PetscInt       i,s,*nnz;
2563 
2564     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2565     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2566     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2567     /* local change of basis for pressures */
2568     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2569     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2570     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2571     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2572     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2573     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2574     for (i=0;i<pcbddc->benign_n;i++) {
2575       PetscInt nzs,j;
2576 
2577       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2578       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2579       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2580       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2581       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2582     }
2583     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2584     ierr = PetscFree(nnz);CHKERRQ(ierr);
2585     /* set identity on velocities */
2586     for (i=0;i<n-nz;i++) {
2587       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2588     }
2589     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2590     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2591     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2592     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2593     /* set change on pressures */
2594     for (s=0;s<pcbddc->benign_n;s++) {
2595       PetscScalar *array;
2596       PetscInt    nzs;
2597 
2598       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2599       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2600       for (i=0;i<nzs-1;i++) {
2601         PetscScalar vals[2];
2602         PetscInt    cols[2];
2603 
2604         cols[0] = idxs[i];
2605         cols[1] = idxs[nzs-1];
2606         vals[0] = 1.;
2607         vals[1] = 1.;
2608         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2609       }
2610       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2611       for (i=0;i<nzs-1;i++) array[i] = -1.;
2612       array[nzs-1] = 1.;
2613       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2614       /* store local idxs for p0 */
2615       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2616       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2617       ierr = PetscFree(array);CHKERRQ(ierr);
2618     }
2619     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2620     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2621     /* project if needed */
2622     if (pcbddc->benign_change_explicit) {
2623       Mat M;
2624 
2625       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2626       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2627       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2628       ierr = MatDestroy(&M);CHKERRQ(ierr);
2629     }
2630     /* store global idxs for p0 */
2631     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2632   }
2633   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2634   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2635 
2636   /* determines if the coarse solver will be singular or not */
2637   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2638   /* determines if the problem has subdomains with 0 pressure block */
2639   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2640   *zerodiaglocal = zerodiag;
2641   PetscFunctionReturn(0);
2642 }
2643 
2644 #undef __FUNCT__
2645 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
2646 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2647 {
2648   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2649   PetscScalar    *array;
2650   PetscErrorCode ierr;
2651 
2652   PetscFunctionBegin;
2653   if (!pcbddc->benign_sf) {
2654     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2655     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2656   }
2657   if (get) {
2658     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2659     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2660     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2661     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2662   } else {
2663     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2664     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2665     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2666     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2667   }
2668   PetscFunctionReturn(0);
2669 }
2670 
2671 #undef __FUNCT__
2672 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
2673 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2674 {
2675   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2676   PetscErrorCode ierr;
2677 
2678   PetscFunctionBegin;
2679   /* TODO: add error checking
2680     - avoid nested pop (or push) calls.
2681     - cannot push before pop.
2682     - cannot call this if pcbddc->local_mat is NULL
2683   */
2684   if (!pcbddc->benign_n) {
2685     PetscFunctionReturn(0);
2686   }
2687   if (pop) {
2688     if (pcbddc->benign_change_explicit) {
2689       IS       is_p0;
2690       MatReuse reuse;
2691 
2692       /* extract B_0 */
2693       reuse = MAT_INITIAL_MATRIX;
2694       if (pcbddc->benign_B0) {
2695         reuse = MAT_REUSE_MATRIX;
2696       }
2697       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2698       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2699       /* remove rows and cols from local problem */
2700       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2701       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2702       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2703       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2704     } else {
2705       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2706       PetscScalar *vals;
2707       PetscInt    i,n,*idxs_ins;
2708 
2709       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2710       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2711       if (!pcbddc->benign_B0) {
2712         PetscInt *nnz;
2713         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2714         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2715         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2716         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2717         for (i=0;i<pcbddc->benign_n;i++) {
2718           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2719           nnz[i] = n - nnz[i];
2720         }
2721         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2722         ierr = PetscFree(nnz);CHKERRQ(ierr);
2723       }
2724 
2725       for (i=0;i<pcbddc->benign_n;i++) {
2726         PetscScalar *array;
2727         PetscInt    *idxs,j,nz,cum;
2728 
2729         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2730         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2731         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2732         for (j=0;j<nz;j++) vals[j] = 1.;
2733         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2734         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2735         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2736         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2737         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2738         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2739         cum = 0;
2740         for (j=0;j<n;j++) {
2741           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2742             vals[cum] = array[j];
2743             idxs_ins[cum] = j;
2744             cum++;
2745           }
2746         }
2747         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2748         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2749         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2750       }
2751       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2752       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2753       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2754     }
2755   } else { /* push */
2756     if (pcbddc->benign_change_explicit) {
2757       PetscInt i;
2758 
2759       for (i=0;i<pcbddc->benign_n;i++) {
2760         PetscScalar *B0_vals;
2761         PetscInt    *B0_cols,B0_ncol;
2762 
2763         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2764         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2765         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2766         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2767         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2768       }
2769       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2770       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2771     } else {
2772       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2773     }
2774   }
2775   PetscFunctionReturn(0);
2776 }
2777 
2778 #undef __FUNCT__
2779 #define __FUNCT__ "PCBDDCAdaptiveSelection"
2780 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2781 {
2782   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2783   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2784   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2785   PetscBLASInt    *B_iwork,*B_ifail;
2786   PetscScalar     *work,lwork;
2787   PetscScalar     *St,*S,*eigv;
2788   PetscScalar     *Sarray,*Starray;
2789   PetscReal       *eigs,thresh;
2790   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2791   PetscBool       allocated_S_St;
2792 #if defined(PETSC_USE_COMPLEX)
2793   PetscReal       *rwork;
2794 #endif
2795   PetscErrorCode  ierr;
2796 
2797   PetscFunctionBegin;
2798   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2799   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2800   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\n",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2801 
2802   if (pcbddc->dbg_flag) {
2803     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2804     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2806     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2807   }
2808 
2809   if (pcbddc->dbg_flag) {
2810     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2811   }
2812 
2813   /* max size of subsets */
2814   mss = 0;
2815   for (i=0;i<sub_schurs->n_subs;i++) {
2816     PetscInt subset_size;
2817 
2818     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2819     mss = PetscMax(mss,subset_size);
2820   }
2821 
2822   /* min/max and threshold */
2823   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2824   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2825   nmax = PetscMax(nmin,nmax);
2826   allocated_S_St = PETSC_FALSE;
2827   if (nmin) {
2828     allocated_S_St = PETSC_TRUE;
2829   }
2830 
2831   /* allocate lapack workspace */
2832   cum = cum2 = 0;
2833   maxneigs = 0;
2834   for (i=0;i<sub_schurs->n_subs;i++) {
2835     PetscInt n,subset_size;
2836 
2837     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2838     n = PetscMin(subset_size,nmax);
2839     cum += subset_size;
2840     cum2 += subset_size*n;
2841     maxneigs = PetscMax(maxneigs,n);
2842   }
2843   if (mss) {
2844     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2845       PetscBLASInt B_itype = 1;
2846       PetscBLASInt B_N = mss;
2847       PetscReal    zero = 0.0;
2848       PetscReal    eps = 0.0; /* dlamch? */
2849 
2850       B_lwork = -1;
2851       S = NULL;
2852       St = NULL;
2853       eigs = NULL;
2854       eigv = NULL;
2855       B_iwork = NULL;
2856       B_ifail = NULL;
2857 #if defined(PETSC_USE_COMPLEX)
2858       rwork = NULL;
2859 #endif
2860       thresh = 1.0;
2861       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2862 #if defined(PETSC_USE_COMPLEX)
2863       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
2864 #else
2865       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
2866 #endif
2867       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2868       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2869     } else {
2870         /* TODO */
2871     }
2872   } else {
2873     lwork = 0;
2874   }
2875 
2876   nv = 0;
2877   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
2878     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2879   }
2880   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2881   if (allocated_S_St) {
2882     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2883   }
2884   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2885 #if defined(PETSC_USE_COMPLEX)
2886   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2887 #endif
2888   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2889                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2890                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2891                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2892                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2893   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2894 
2895   maxneigs = 0;
2896   cum = cumarray = 0;
2897   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2898   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2899   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2900     const PetscInt *idxs;
2901 
2902     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2903     for (cum=0;cum<nv;cum++) {
2904       pcbddc->adaptive_constraints_n[cum] = 1;
2905       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2906       pcbddc->adaptive_constraints_data[cum] = 1.0;
2907       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2908       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2909     }
2910     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2911   }
2912 
2913   if (mss) { /* multilevel */
2914     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2915     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2916   }
2917 
2918   thresh = pcbddc->adaptive_threshold;
2919   for (i=0;i<sub_schurs->n_subs;i++) {
2920     const PetscInt *idxs;
2921     PetscReal      upper,lower;
2922     PetscInt       j,subset_size,eigs_start = 0;
2923     PetscBLASInt   B_N;
2924     PetscBool      same_data = PETSC_FALSE;
2925 
2926     if (pcbddc->use_deluxe_scaling) {
2927       upper = PETSC_MAX_REAL;
2928       lower = thresh;
2929     } else {
2930       upper = 1./thresh;
2931       lower = 0.;
2932     }
2933     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2934     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2935     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2936     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2937       if (sub_schurs->is_hermitian) {
2938         PetscInt j,k;
2939         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2940           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2941           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2942         }
2943         for (j=0;j<subset_size;j++) {
2944           for (k=j;k<subset_size;k++) {
2945             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2946             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2947           }
2948         }
2949       } else {
2950         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2951         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2952       }
2953     } else {
2954       S = Sarray + cumarray;
2955       St = Starray + cumarray;
2956     }
2957     /* see if we can save some work */
2958     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2959       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2960     }
2961 
2962     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2963       B_neigs = 0;
2964     } else {
2965       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2966         PetscBLASInt B_itype = 1;
2967         PetscBLASInt B_IL, B_IU;
2968         PetscReal    eps = -1.0; /* dlamch? */
2969         PetscInt     nmin_s;
2970         PetscBool    compute_range = PETSC_FALSE;
2971 
2972         if (pcbddc->dbg_flag) {
2973           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
2974         }
2975 
2976         compute_range = PETSC_FALSE;
2977         if (thresh > 1.+PETSC_SMALL && !same_data) {
2978           compute_range = PETSC_TRUE;
2979         }
2980 
2981         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2982         if (compute_range) {
2983 
2984           /* ask for eigenvalues larger than thresh */
2985 #if defined(PETSC_USE_COMPLEX)
2986           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
2987 #else
2988           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
2989 #endif
2990         } else if (!same_data) {
2991           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2992           B_IL = 1;
2993 #if defined(PETSC_USE_COMPLEX)
2994           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
2995 #else
2996           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
2997 #endif
2998         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2999           PetscInt k;
3000           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3001           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3002           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3003           nmin = nmax;
3004           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3005           for (k=0;k<nmax;k++) {
3006             eigs[k] = 1./PETSC_SMALL;
3007             eigv[k*(subset_size+1)] = 1.0;
3008           }
3009         }
3010         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3011         if (B_ierr) {
3012           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3013           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3014           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3015         }
3016 
3017         if (B_neigs > nmax) {
3018           if (pcbddc->dbg_flag) {
3019             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3020           }
3021           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3022           B_neigs = nmax;
3023         }
3024 
3025         nmin_s = PetscMin(nmin,B_N);
3026         if (B_neigs < nmin_s) {
3027           PetscBLASInt B_neigs2;
3028 
3029           if (pcbddc->use_deluxe_scaling) {
3030             B_IL = B_N - nmin_s + 1;
3031             B_IU = B_N - B_neigs;
3032           } else {
3033             B_IL = B_neigs + 1;
3034             B_IU = nmin_s;
3035           }
3036           if (pcbddc->dbg_flag) {
3037             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
3038           }
3039           if (sub_schurs->is_hermitian) {
3040             PetscInt j,k;
3041             for (j=0;j<subset_size;j++) {
3042               for (k=j;k<subset_size;k++) {
3043                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3044                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3045               }
3046             }
3047           } else {
3048             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3049             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3050           }
3051           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3052 #if defined(PETSC_USE_COMPLEX)
3053           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3054 #else
3055           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3056 #endif
3057           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3058           B_neigs += B_neigs2;
3059         }
3060         if (B_ierr) {
3061           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3062           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3063           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3064         }
3065         if (pcbddc->dbg_flag) {
3066           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3067           for (j=0;j<B_neigs;j++) {
3068             if (eigs[j] == 0.0) {
3069               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3070             } else {
3071               if (pcbddc->use_deluxe_scaling) {
3072                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3073               } else {
3074                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3075               }
3076             }
3077           }
3078         }
3079       } else {
3080           /* TODO */
3081       }
3082     }
3083     /* change the basis back to the original one */
3084     if (sub_schurs->change) {
3085       Mat change,phi,phit;
3086 
3087       if (pcbddc->dbg_flag > 1) {
3088         PetscInt ii;
3089         for (ii=0;ii<B_neigs;ii++) {
3090           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3091           for (j=0;j<B_N;j++) {
3092 #if defined(PETSC_USE_COMPLEX)
3093             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3094             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3095             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3096 #else
3097             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3098 #endif
3099           }
3100         }
3101       }
3102       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3103       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3104       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3105       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3106       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3107       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3108     }
3109     maxneigs = PetscMax(B_neigs,maxneigs);
3110     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3111     if (B_neigs) {
3112       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3113 
3114       if (pcbddc->dbg_flag > 1) {
3115         PetscInt ii;
3116         for (ii=0;ii<B_neigs;ii++) {
3117           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3118           for (j=0;j<B_N;j++) {
3119 #if defined(PETSC_USE_COMPLEX)
3120             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3121             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3122             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3123 #else
3124             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3125 #endif
3126           }
3127         }
3128       }
3129       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3130       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3131       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3132       cum++;
3133     }
3134     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3135     /* shift for next computation */
3136     cumarray += subset_size*subset_size;
3137   }
3138   if (pcbddc->dbg_flag) {
3139     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3140   }
3141 
3142   if (mss) {
3143     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3144     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3145     /* destroy matrices (junk) */
3146     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3147     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3148   }
3149   if (allocated_S_St) {
3150     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3151   }
3152   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3153 #if defined(PETSC_USE_COMPLEX)
3154   ierr = PetscFree(rwork);CHKERRQ(ierr);
3155 #endif
3156   if (pcbddc->dbg_flag) {
3157     PetscInt maxneigs_r;
3158     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3159     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3160   }
3161   PetscFunctionReturn(0);
3162 }
3163 
3164 #undef __FUNCT__
3165 #define __FUNCT__ "PCBDDCSetUpSolvers"
3166 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3167 {
3168   PetscScalar    *coarse_submat_vals;
3169   PetscErrorCode ierr;
3170 
3171   PetscFunctionBegin;
3172   /* Setup local scatters R_to_B and (optionally) R_to_D */
3173   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3174   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3175 
3176   /* Setup local neumann solver ksp_R */
3177   /* PCBDDCSetUpLocalScatters should be called first! */
3178   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3179 
3180   /*
3181      Setup local correction and local part of coarse basis.
3182      Gives back the dense local part of the coarse matrix in column major ordering
3183   */
3184   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3185 
3186   /* Compute total number of coarse nodes and setup coarse solver */
3187   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3188 
3189   /* free */
3190   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3191   PetscFunctionReturn(0);
3192 }
3193 
3194 #undef __FUNCT__
3195 #define __FUNCT__ "PCBDDCResetCustomization"
3196 PetscErrorCode PCBDDCResetCustomization(PC pc)
3197 {
3198   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3199   PetscErrorCode ierr;
3200 
3201   PetscFunctionBegin;
3202   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3203   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3204   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3205   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3206   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3207   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3208   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3209   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3210   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3211   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3212   PetscFunctionReturn(0);
3213 }
3214 
3215 #undef __FUNCT__
3216 #define __FUNCT__ "PCBDDCResetTopography"
3217 PetscErrorCode PCBDDCResetTopography(PC pc)
3218 {
3219   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3220   PetscInt       i;
3221   PetscErrorCode ierr;
3222 
3223   PetscFunctionBegin;
3224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3226   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3227   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3228   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3229   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3230   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3231   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3232   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3233   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3234   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
3235   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
3236   for (i=0;i<pcbddc->n_local_subs;i++) {
3237     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3238   }
3239   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3240   if (pcbddc->sub_schurs) {
3241     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
3242   }
3243   pcbddc->graphanalyzed        = PETSC_FALSE;
3244   pcbddc->recompute_topography = PETSC_TRUE;
3245   PetscFunctionReturn(0);
3246 }
3247 
3248 #undef __FUNCT__
3249 #define __FUNCT__ "PCBDDCResetSolvers"
3250 PetscErrorCode PCBDDCResetSolvers(PC pc)
3251 {
3252   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3253   PetscErrorCode ierr;
3254 
3255   PetscFunctionBegin;
3256   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3257   if (pcbddc->coarse_phi_B) {
3258     PetscScalar *array;
3259     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3260     ierr = PetscFree(array);CHKERRQ(ierr);
3261   }
3262   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3263   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3264   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3265   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3266   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3267   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3268   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3269   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3270   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3271   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3272   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3273   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3274   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3275   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3276   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
3277   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
3278   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
3279   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3280   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3281   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3282   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3283   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3284   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3285   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3286   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3287   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3288   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3289   if (pcbddc->benign_zerodiag_subs) {
3290     PetscInt i;
3291     for (i=0;i<pcbddc->benign_n;i++) {
3292       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3293     }
3294     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3295   }
3296   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3297   PetscFunctionReturn(0);
3298 }
3299 
3300 #undef __FUNCT__
3301 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
3302 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3303 {
3304   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3305   PC_IS          *pcis = (PC_IS*)pc->data;
3306   VecType        impVecType;
3307   PetscInt       n_constraints,n_R,old_size;
3308   PetscErrorCode ierr;
3309 
3310   PetscFunctionBegin;
3311   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3312   n_R = pcis->n - pcbddc->n_vertices;
3313   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3314   /* local work vectors (try to avoid unneeded work)*/
3315   /* R nodes */
3316   old_size = -1;
3317   if (pcbddc->vec1_R) {
3318     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3319   }
3320   if (n_R != old_size) {
3321     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3322     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3323     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3324     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3325     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3326     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3327   }
3328   /* local primal dofs */
3329   old_size = -1;
3330   if (pcbddc->vec1_P) {
3331     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3332   }
3333   if (pcbddc->local_primal_size != old_size) {
3334     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3335     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3336     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3337     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3338   }
3339   /* local explicit constraints */
3340   old_size = -1;
3341   if (pcbddc->vec1_C) {
3342     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3343   }
3344   if (n_constraints && n_constraints != old_size) {
3345     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3346     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3347     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3348     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3349   }
3350   PetscFunctionReturn(0);
3351 }
3352 
3353 #undef __FUNCT__
3354 #define __FUNCT__ "PCBDDCSetUpCorrection"
3355 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3356 {
3357   PetscErrorCode  ierr;
3358   /* pointers to pcis and pcbddc */
3359   PC_IS*          pcis = (PC_IS*)pc->data;
3360   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3361   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3362   /* submatrices of local problem */
3363   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3364   /* submatrices of local coarse problem */
3365   Mat             S_VV,S_CV,S_VC,S_CC;
3366   /* working matrices */
3367   Mat             C_CR;
3368   /* additional working stuff */
3369   PC              pc_R;
3370   Mat             F;
3371   Vec             dummy_vec;
3372   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3373   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3374   PetscScalar     *work;
3375   PetscInt        *idx_V_B;
3376   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3377   PetscInt        i,n_R,n_D,n_B;
3378 
3379   /* some shortcuts to scalars */
3380   PetscScalar     one=1.0,m_one=-1.0;
3381 
3382   PetscFunctionBegin;
3383   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3384 
3385   /* Set Non-overlapping dimensions */
3386   n_vertices = pcbddc->n_vertices;
3387   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3388   n_B = pcis->n_B;
3389   n_D = pcis->n - n_B;
3390   n_R = pcis->n - n_vertices;
3391 
3392   /* vertices in boundary numbering */
3393   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3394   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3395   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3396 
3397   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3398   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3399   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3400   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3401   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3402   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3403   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3404   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3405   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3406   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3407 
3408   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3409   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3410   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3411   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3412   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3413   lda_rhs = n_R;
3414   need_benign_correction = PETSC_FALSE;
3415   if (isLU || isILU || isCHOL) {
3416     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3417   } else if (sub_schurs && sub_schurs->reuse_solver) {
3418     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3419     MatFactorType      type;
3420 
3421     F = reuse_solver->F;
3422     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3423     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3424     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3425     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3426   } else {
3427     F = NULL;
3428   }
3429 
3430   /* allocate workspace */
3431   n = 0;
3432   if (n_constraints) {
3433     n += lda_rhs*n_constraints;
3434   }
3435   if (n_vertices) {
3436     n = PetscMax(2*lda_rhs*n_vertices,n);
3437     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3438   }
3439   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3440 
3441   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3442   dummy_vec = NULL;
3443   if (need_benign_correction && lda_rhs != n_R && F) {
3444     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3445   }
3446 
3447   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3448   if (n_constraints) {
3449     Mat         M1,M2,M3,C_B;
3450     IS          is_aux;
3451     PetscScalar *array,*array2;
3452 
3453     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3454     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3455 
3456     /* Extract constraints on R nodes: C_{CR}  */
3457     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3458     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3459     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3460 
3461     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3462     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3463     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3464     for (i=0;i<n_constraints;i++) {
3465       const PetscScalar *row_cmat_values;
3466       const PetscInt    *row_cmat_indices;
3467       PetscInt          size_of_constraint,j;
3468 
3469       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3470       for (j=0;j<size_of_constraint;j++) {
3471         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3472       }
3473       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3474     }
3475     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3476     if (F) {
3477       Mat B;
3478 
3479       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3480       if (need_benign_correction) {
3481         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3482 
3483         /* rhs is already zero on interior dofs, no need to change the rhs */
3484         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3485       }
3486       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3487       if (need_benign_correction) {
3488         PetscScalar        *marr;
3489         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3490 
3491         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3492         if (lda_rhs != n_R) {
3493           for (i=0;i<n_constraints;i++) {
3494             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3495             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3496             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3497           }
3498         } else {
3499           for (i=0;i<n_constraints;i++) {
3500             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3501             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3502             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3503           }
3504         }
3505         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3506       }
3507       ierr = MatDestroy(&B);CHKERRQ(ierr);
3508     } else {
3509       PetscScalar *marr;
3510 
3511       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3512       for (i=0;i<n_constraints;i++) {
3513         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3514         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3515         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3516         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3517         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3518       }
3519       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3520     }
3521     if (!pcbddc->switch_static) {
3522       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3523       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3524       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3525       for (i=0;i<n_constraints;i++) {
3526         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3527         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3528         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3529         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3530         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3531         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3532       }
3533       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3534       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3535       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3536     } else {
3537       if (lda_rhs != n_R) {
3538         IS dummy;
3539 
3540         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3541         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3542         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3543       } else {
3544         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3545         pcbddc->local_auxmat2 = local_auxmat2_R;
3546       }
3547       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3548     }
3549     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3550     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3551     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3552     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3553     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3554     if (isCHOL) {
3555       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3556     } else {
3557       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3558     }
3559     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3560     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3561     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3562     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3563     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3564     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3565     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3566     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3567     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3568     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3569   }
3570 
3571   /* Get submatrices from subdomain matrix */
3572   if (n_vertices) {
3573     IS is_aux;
3574 
3575     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3576       IS tis;
3577 
3578       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3579       ierr = ISSort(tis);CHKERRQ(ierr);
3580       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3581       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3582     } else {
3583       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3584     }
3585     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3586     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3587     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3588     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3589   }
3590 
3591   /* Matrix of coarse basis functions (local) */
3592   if (pcbddc->coarse_phi_B) {
3593     PetscInt on_B,on_primal,on_D=n_D;
3594     if (pcbddc->coarse_phi_D) {
3595       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3596     }
3597     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3598     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3599       PetscScalar *marray;
3600 
3601       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3602       ierr = PetscFree(marray);CHKERRQ(ierr);
3603       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3604       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3605       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3606       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3607     }
3608   }
3609 
3610   if (!pcbddc->coarse_phi_B) {
3611     PetscScalar *marray;
3612 
3613     n = n_B*pcbddc->local_primal_size;
3614     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3615       n += n_D*pcbddc->local_primal_size;
3616     }
3617     if (!pcbddc->symmetric_primal) {
3618       n *= 2;
3619     }
3620     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
3621     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3622     n = n_B*pcbddc->local_primal_size;
3623     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3624       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3625       n += n_D*pcbddc->local_primal_size;
3626     }
3627     if (!pcbddc->symmetric_primal) {
3628       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3629       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3630         n = n_B*pcbddc->local_primal_size;
3631         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3632       }
3633     } else {
3634       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3635       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3636       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3637         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3638         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3639       }
3640     }
3641   }
3642 
3643   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3644   p0_lidx_I = NULL;
3645   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3646     const PetscInt *idxs;
3647 
3648     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3649     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3650     for (i=0;i<pcbddc->benign_n;i++) {
3651       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3652     }
3653     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3654   }
3655 
3656   /* vertices */
3657   if (n_vertices) {
3658 
3659     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3660 
3661     if (n_R) {
3662       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3663       PetscBLASInt B_N,B_one = 1;
3664       PetscScalar  *x,*y;
3665       PetscBool    isseqaij;
3666 
3667       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3668       if (need_benign_correction) {
3669         ISLocalToGlobalMapping RtoN;
3670         IS                     is_p0;
3671         PetscInt               *idxs_p0,n;
3672 
3673         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3674         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3675         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3676         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3677         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3678         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3679         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3680         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3681       }
3682 
3683       if (lda_rhs == n_R) {
3684         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3685       } else {
3686         PetscScalar    *av,*array;
3687         const PetscInt *xadj,*adjncy;
3688         PetscInt       n;
3689         PetscBool      flg_row;
3690 
3691         array = work+lda_rhs*n_vertices;
3692         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3693         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3694         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3695         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3696         for (i=0;i<n;i++) {
3697           PetscInt j;
3698           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3699         }
3700         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3701         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3702         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3703       }
3704       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3705       if (need_benign_correction) {
3706         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3707         PetscScalar        *marr;
3708 
3709         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3710         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3711 
3712                | 0 0  0 | (V)
3713            L = | 0 0 -1 | (P-p0)
3714                | 0 0 -1 | (p0)
3715 
3716         */
3717         for (i=0;i<reuse_solver->benign_n;i++) {
3718           const PetscScalar *vals;
3719           const PetscInt    *idxs,*idxs_zero;
3720           PetscInt          n,j,nz;
3721 
3722           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3723           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3724           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3725           for (j=0;j<n;j++) {
3726             PetscScalar val = vals[j];
3727             PetscInt    k,col = idxs[j];
3728             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3729           }
3730           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3731           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3732         }
3733         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3734       }
3735       if (F) {
3736         /* need to correct the rhs */
3737         if (need_benign_correction) {
3738           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3739           PetscScalar        *marr;
3740 
3741           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3742           if (lda_rhs != n_R) {
3743             for (i=0;i<n_vertices;i++) {
3744               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3745               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3746               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3747             }
3748           } else {
3749             for (i=0;i<n_vertices;i++) {
3750               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3751               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3752               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3753             }
3754           }
3755           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3756         }
3757         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3758         /* need to correct the solution */
3759         if (need_benign_correction) {
3760           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3761           PetscScalar        *marr;
3762 
3763           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3764           if (lda_rhs != n_R) {
3765             for (i=0;i<n_vertices;i++) {
3766               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3767               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3768               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3769             }
3770           } else {
3771             for (i=0;i<n_vertices;i++) {
3772               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3773               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3774               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3775             }
3776           }
3777           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3778         }
3779       } else {
3780         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3781         for (i=0;i<n_vertices;i++) {
3782           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3783           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3784           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3785           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3786           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3787         }
3788         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3789       }
3790       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3791       /* S_VV and S_CV */
3792       if (n_constraints) {
3793         Mat B;
3794 
3795         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3796         for (i=0;i<n_vertices;i++) {
3797           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3798           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3799           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3800           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3801           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3802           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3803         }
3804         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3805         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3806         ierr = MatDestroy(&B);CHKERRQ(ierr);
3807         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3808         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3809         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3810         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3811         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3812         ierr = MatDestroy(&B);CHKERRQ(ierr);
3813       }
3814       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3815       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3816         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3817       }
3818       if (lda_rhs != n_R) {
3819         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3820         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3821         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3822       }
3823       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3824       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3825       if (need_benign_correction) {
3826         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3827         PetscScalar      *marr,*sums;
3828 
3829         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3830         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3831         for (i=0;i<reuse_solver->benign_n;i++) {
3832           const PetscScalar *vals;
3833           const PetscInt    *idxs,*idxs_zero;
3834           PetscInt          n,j,nz;
3835 
3836           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3837           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3838           for (j=0;j<n_vertices;j++) {
3839             PetscInt k;
3840             sums[j] = 0.;
3841             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3842           }
3843           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3844           for (j=0;j<n;j++) {
3845             PetscScalar val = vals[j];
3846             PetscInt k;
3847             for (k=0;k<n_vertices;k++) {
3848               marr[idxs[j]+k*n_vertices] += val*sums[k];
3849             }
3850           }
3851           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3852           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3853         }
3854         ierr = PetscFree(sums);CHKERRQ(ierr);
3855         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3856         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3857       }
3858       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3859       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3860       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3861       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3862       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3863       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3864       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3865       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3866       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3867     } else {
3868       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3869     }
3870     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3871 
3872     /* coarse basis functions */
3873     for (i=0;i<n_vertices;i++) {
3874       PetscScalar *y;
3875 
3876       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3877       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3878       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3879       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3880       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3881       y[n_B*i+idx_V_B[i]] = 1.0;
3882       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3883       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3884 
3885       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3886         PetscInt j;
3887 
3888         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3889         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3890         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3891         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3892         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3893         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3894         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3895       }
3896       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3897     }
3898     /* if n_R == 0 the object is not destroyed */
3899     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3900   }
3901   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3902 
3903   if (n_constraints) {
3904     Mat B;
3905 
3906     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3907     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3908     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3909     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3910     if (n_vertices) {
3911       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3912         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3913       } else {
3914         Mat S_VCt;
3915 
3916         if (lda_rhs != n_R) {
3917           ierr = MatDestroy(&B);CHKERRQ(ierr);
3918           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3919           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3920         }
3921         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3922         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3923         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3924       }
3925     }
3926     ierr = MatDestroy(&B);CHKERRQ(ierr);
3927     /* coarse basis functions */
3928     for (i=0;i<n_constraints;i++) {
3929       PetscScalar *y;
3930 
3931       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3932       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3933       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3934       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3935       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3936       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3937       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3938       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3939         PetscInt j;
3940 
3941         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3942         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3943         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3944         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3945         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3946         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3947         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3948       }
3949       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3950     }
3951   }
3952   if (n_constraints) {
3953     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3954   }
3955   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3956 
3957   /* coarse matrix entries relative to B_0 */
3958   if (pcbddc->benign_n) {
3959     Mat         B0_B,B0_BPHI;
3960     IS          is_dummy;
3961     PetscScalar *data;
3962     PetscInt    j;
3963 
3964     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3965     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3966     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3967     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3968     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3969     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3970     for (j=0;j<pcbddc->benign_n;j++) {
3971       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3972       for (i=0;i<pcbddc->local_primal_size;i++) {
3973         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3974         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3975       }
3976     }
3977     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3978     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3979     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3980   }
3981 
3982   /* compute other basis functions for non-symmetric problems */
3983   if (!pcbddc->symmetric_primal) {
3984     Mat         B_V=NULL,B_C=NULL;
3985     PetscScalar *marray;
3986 
3987     if (n_constraints) {
3988       Mat S_CCT,C_CRT;
3989 
3990       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
3991       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3992       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3993       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3994       if (n_vertices) {
3995         Mat S_VCT;
3996 
3997         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3998         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3999         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4000       }
4001       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4002     } else {
4003       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4004     }
4005     if (n_vertices && n_R) {
4006       PetscScalar    *av,*marray;
4007       const PetscInt *xadj,*adjncy;
4008       PetscInt       n;
4009       PetscBool      flg_row;
4010 
4011       /* B_V = B_V - A_VR^T */
4012       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4013       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4014       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4015       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4016       for (i=0;i<n;i++) {
4017         PetscInt j;
4018         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4019       }
4020       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4021       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4022       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4023     }
4024 
4025     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4026     if (n_vertices) {
4027       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4028       for (i=0;i<n_vertices;i++) {
4029         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4030         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4031         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4032         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4033         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4034       }
4035       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4036     }
4037     if (B_C) {
4038       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4039       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4040         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4041         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4042         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4043         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4044         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4045       }
4046       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4047     }
4048     /* coarse basis functions */
4049     for (i=0;i<pcbddc->local_primal_size;i++) {
4050       PetscScalar *y;
4051 
4052       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4053       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4054       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4055       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4056       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4057       if (i<n_vertices) {
4058         y[n_B*i+idx_V_B[i]] = 1.0;
4059       }
4060       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4061       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4062 
4063       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4064         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4065         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4066         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4067         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4068         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4069         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4070       }
4071       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4072     }
4073     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4074     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
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;
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   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4460   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4461   if (isseqaij) {
4462     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4463     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4464   } else {
4465     Mat work_mat;
4466 
4467     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4468     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4469     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4470     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4471   }
4472   if (matis->A->symmetric_set) {
4473     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4474 #if !defined(PETSC_USE_COMPLEX)
4475     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4476 #endif
4477   }
4478   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4479   PetscFunctionReturn(0);
4480 }
4481 
4482 #undef __FUNCT__
4483 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4484 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4485 {
4486   PC_IS*          pcis = (PC_IS*)(pc->data);
4487   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4488   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4489   PetscInt        *idx_R_local=NULL;
4490   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4491   PetscInt        vbs,bs;
4492   PetscBT         bitmask=NULL;
4493   PetscErrorCode  ierr;
4494 
4495   PetscFunctionBegin;
4496   /*
4497     No need to setup local scatters if
4498       - primal space is unchanged
4499         AND
4500       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4501         AND
4502       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4503   */
4504   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4505     PetscFunctionReturn(0);
4506   }
4507   /* destroy old objects */
4508   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4509   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4510   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4511   /* Set Non-overlapping dimensions */
4512   n_B = pcis->n_B;
4513   n_D = pcis->n - n_B;
4514   n_vertices = pcbddc->n_vertices;
4515 
4516   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4517 
4518   /* create auxiliary bitmask and allocate workspace */
4519   if (!sub_schurs || !sub_schurs->reuse_solver) {
4520     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4521     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4522     for (i=0;i<n_vertices;i++) {
4523       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4524     }
4525 
4526     for (i=0, n_R=0; i<pcis->n; i++) {
4527       if (!PetscBTLookup(bitmask,i)) {
4528         idx_R_local[n_R++] = i;
4529       }
4530     }
4531   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4532     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4533 
4534     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4535     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4536   }
4537 
4538   /* Block code */
4539   vbs = 1;
4540   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4541   if (bs>1 && !(n_vertices%bs)) {
4542     PetscBool is_blocked = PETSC_TRUE;
4543     PetscInt  *vary;
4544     if (!sub_schurs || !sub_schurs->reuse_solver) {
4545       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4546       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4547       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4548       /* 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 */
4549       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4550       for (i=0; i<pcis->n/bs; i++) {
4551         if (vary[i]!=0 && vary[i]!=bs) {
4552           is_blocked = PETSC_FALSE;
4553           break;
4554         }
4555       }
4556       ierr = PetscFree(vary);CHKERRQ(ierr);
4557     } else {
4558       /* Verify directly the R set */
4559       for (i=0; i<n_R/bs; i++) {
4560         PetscInt j,node=idx_R_local[bs*i];
4561         for (j=1; j<bs; j++) {
4562           if (node != idx_R_local[bs*i+j]-j) {
4563             is_blocked = PETSC_FALSE;
4564             break;
4565           }
4566         }
4567       }
4568     }
4569     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4570       vbs = bs;
4571       for (i=0;i<n_R/vbs;i++) {
4572         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4573       }
4574     }
4575   }
4576   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4577   if (sub_schurs && sub_schurs->reuse_solver) {
4578     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4579 
4580     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4581     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4582     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4583     reuse_solver->is_R = pcbddc->is_R_local;
4584   } else {
4585     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4586   }
4587 
4588   /* print some info if requested */
4589   if (pcbddc->dbg_flag) {
4590     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4591     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4592     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4593     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4594     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4595     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);
4596     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4597   }
4598 
4599   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4600   if (!sub_schurs || !sub_schurs->reuse_solver) {
4601     IS       is_aux1,is_aux2;
4602     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4603 
4604     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4605     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4606     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4607     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4608     for (i=0; i<n_D; i++) {
4609       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4610     }
4611     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4612     for (i=0, j=0; i<n_R; i++) {
4613       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4614         aux_array1[j++] = i;
4615       }
4616     }
4617     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4618     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4619     for (i=0, j=0; i<n_B; i++) {
4620       if (!PetscBTLookup(bitmask,is_indices[i])) {
4621         aux_array2[j++] = i;
4622       }
4623     }
4624     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4625     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4626     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4627     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4628     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4629 
4630     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4631       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4632       for (i=0, j=0; i<n_R; i++) {
4633         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4634           aux_array1[j++] = i;
4635         }
4636       }
4637       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4638       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4639       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4640     }
4641     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4642     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4643   } else {
4644     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4645     IS                 tis;
4646     PetscInt           schur_size;
4647 
4648     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4649     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4650     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4651     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4652     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4653       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4654       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4655       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4656     }
4657   }
4658   PetscFunctionReturn(0);
4659 }
4660 
4661 
4662 #undef __FUNCT__
4663 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4664 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4665 {
4666   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4667   PC_IS          *pcis = (PC_IS*)pc->data;
4668   PC             pc_temp;
4669   Mat            A_RR;
4670   MatReuse       reuse;
4671   PetscScalar    m_one = -1.0;
4672   PetscReal      value;
4673   PetscInt       n_D,n_R;
4674   PetscBool      check_corr[2],issbaij;
4675   PetscErrorCode ierr;
4676   /* prefixes stuff */
4677   char           dir_prefix[256],neu_prefix[256],str_level[16];
4678   size_t         len;
4679 
4680   PetscFunctionBegin;
4681 
4682   /* compute prefixes */
4683   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4684   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4685   if (!pcbddc->current_level) {
4686     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4687     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4688     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4689     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4690   } else {
4691     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4692     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4693     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4694     len -= 15; /* remove "pc_bddc_coarse_" */
4695     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4696     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4697     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4698     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4699     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4700     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4701     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4702     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4703   }
4704 
4705   /* DIRICHLET PROBLEM */
4706   if (dirichlet) {
4707     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4708     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4709       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4710       if (pcbddc->dbg_flag) {
4711         Mat    A_IIn;
4712 
4713         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4714         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4715         pcis->A_II = A_IIn;
4716       }
4717     }
4718     if (pcbddc->local_mat->symmetric_set) {
4719       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4720     }
4721     /* Matrix for Dirichlet problem is pcis->A_II */
4722     n_D = pcis->n - pcis->n_B;
4723     if (!pcbddc->ksp_D) { /* create object if not yet build */
4724       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4725       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4726       /* default */
4727       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4728       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4729       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4730       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4731       if (issbaij) {
4732         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4733       } else {
4734         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4735       }
4736       /* Allow user's customization */
4737       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4738       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4739     }
4740     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4741     if (sub_schurs && sub_schurs->reuse_solver) {
4742       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4743 
4744       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4745     }
4746     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4747     if (!n_D) {
4748       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4749       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4750     }
4751     /* Set Up KSP for Dirichlet problem of BDDC */
4752     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4753     /* set ksp_D into pcis data */
4754     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4755     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4756     pcis->ksp_D = pcbddc->ksp_D;
4757   }
4758 
4759   /* NEUMANN PROBLEM */
4760   A_RR = 0;
4761   if (neumann) {
4762     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4763     PetscInt        ibs,mbs;
4764     PetscBool       issbaij;
4765     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4766     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4767     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4768     if (pcbddc->ksp_R) { /* already created ksp */
4769       PetscInt nn_R;
4770       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4771       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4772       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4773       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4774         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4775         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4776         reuse = MAT_INITIAL_MATRIX;
4777       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4778         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4779           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4780           reuse = MAT_INITIAL_MATRIX;
4781         } else { /* safe to reuse the matrix */
4782           reuse = MAT_REUSE_MATRIX;
4783         }
4784       }
4785       /* last check */
4786       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4787         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4788         reuse = MAT_INITIAL_MATRIX;
4789       }
4790     } else { /* first time, so we need to create the matrix */
4791       reuse = MAT_INITIAL_MATRIX;
4792     }
4793     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4794     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4795     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4796     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4797     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4798       if (matis->A == pcbddc->local_mat) {
4799         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4800         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4801       } else {
4802         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4803       }
4804     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4805       if (matis->A == pcbddc->local_mat) {
4806         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4807         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4808       } else {
4809         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4810       }
4811     }
4812     /* extract A_RR */
4813     if (sub_schurs && sub_schurs->reuse_solver) {
4814       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4815 
4816       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4817         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4818         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4819           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4820         } else {
4821           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4822         }
4823       } else {
4824         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4825         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4826         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4827       }
4828     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4829       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4830     }
4831     if (pcbddc->local_mat->symmetric_set) {
4832       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4833     }
4834     if (!pcbddc->ksp_R) { /* create object if not present */
4835       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4836       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4837       /* default */
4838       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4839       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4840       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4841       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4842       if (issbaij) {
4843         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4844       } else {
4845         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4846       }
4847       /* Allow user's customization */
4848       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4849       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4850     }
4851     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4852     if (!n_R) {
4853       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4854       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4855     }
4856     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4857     /* Reuse solver if it is present */
4858     if (sub_schurs && sub_schurs->reuse_solver) {
4859       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4860 
4861       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4862     }
4863     /* Set Up KSP for Neumann problem of BDDC */
4864     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4865   }
4866 
4867   if (pcbddc->dbg_flag) {
4868     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4869     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4870     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4871   }
4872 
4873   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4874   check_corr[0] = check_corr[1] = PETSC_FALSE;
4875   if (pcbddc->NullSpace_corr[0]) {
4876     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4877   }
4878   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4879     check_corr[0] = PETSC_TRUE;
4880     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4881   }
4882   if (neumann && pcbddc->NullSpace_corr[2]) {
4883     check_corr[1] = PETSC_TRUE;
4884     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4885   }
4886 
4887   /* check Dirichlet and Neumann solvers */
4888   if (pcbddc->dbg_flag) {
4889     if (dirichlet) { /* Dirichlet */
4890       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4891       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4892       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4893       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4894       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4895       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);
4896       if (check_corr[0]) {
4897         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4898       }
4899       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4900     }
4901     if (neumann) { /* Neumann */
4902       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4903       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4904       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4905       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4906       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4907       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);
4908       if (check_corr[1]) {
4909         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4910       }
4911       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4912     }
4913   }
4914   /* free Neumann problem's matrix */
4915   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4916   PetscFunctionReturn(0);
4917 }
4918 
4919 #undef __FUNCT__
4920 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4921 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4922 {
4923   PetscErrorCode  ierr;
4924   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4925   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4926   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4927 
4928   PetscFunctionBegin;
4929   if (!reuse_solver) {
4930     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4931   }
4932   if (!pcbddc->switch_static) {
4933     if (applytranspose && pcbddc->local_auxmat1) {
4934       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4935       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4936     }
4937     if (!reuse_solver) {
4938       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4939       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4940     } else {
4941       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4942 
4943       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4944       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4945     }
4946   } else {
4947     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4948     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4949     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4950     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4951     if (applytranspose && pcbddc->local_auxmat1) {
4952       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4953       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
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     }
4957   }
4958   if (!reuse_solver || pcbddc->switch_static) {
4959     if (applytranspose) {
4960       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4961     } else {
4962       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4963     }
4964   } else {
4965     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4966 
4967     if (applytranspose) {
4968       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4969     } else {
4970       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4971     }
4972   }
4973   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4974   if (!pcbddc->switch_static) {
4975     if (!reuse_solver) {
4976       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4977       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4978     } else {
4979       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4980 
4981       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4982       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4983     }
4984     if (!applytranspose && pcbddc->local_auxmat1) {
4985       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4986       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4987     }
4988   } else {
4989     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4990     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4991     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4992     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4993     if (!applytranspose && pcbddc->local_auxmat1) {
4994       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4995       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4996     }
4997     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4998     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4999     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5000     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5001   }
5002   PetscFunctionReturn(0);
5003 }
5004 
5005 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5006 #undef __FUNCT__
5007 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
5008 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5009 {
5010   PetscErrorCode ierr;
5011   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5012   PC_IS*            pcis = (PC_IS*)  (pc->data);
5013   const PetscScalar zero = 0.0;
5014 
5015   PetscFunctionBegin;
5016   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5017   if (!pcbddc->benign_apply_coarse_only) {
5018     if (applytranspose) {
5019       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5020       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5021     } else {
5022       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5023       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5024     }
5025   } else {
5026     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5027   }
5028 
5029   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5030   if (pcbddc->benign_n) {
5031     PetscScalar *array;
5032     PetscInt    j;
5033 
5034     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5035     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5036     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5037   }
5038 
5039   /* start communications from local primal nodes to rhs of coarse solver */
5040   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5041   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5042   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5043 
5044   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5045   if (pcbddc->coarse_ksp) {
5046     Mat          coarse_mat;
5047     Vec          rhs,sol;
5048     MatNullSpace nullsp;
5049     PetscBool    isbddc = PETSC_FALSE;
5050 
5051     if (pcbddc->benign_have_null) {
5052       PC        coarse_pc;
5053 
5054       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5055       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5056       /* we need to propagate to coarser levels the need for a possible benign correction */
5057       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5058         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5059         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5060         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5061       }
5062     }
5063     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5064     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5065     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5066     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5067     if (nullsp) {
5068       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5069     }
5070     if (applytranspose) {
5071       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5072       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5073     } else {
5074       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5075         PC        coarse_pc;
5076 
5077         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5078         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5079         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5080         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5081       } else {
5082         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5083       }
5084     }
5085     /* we don't need the benign correction at coarser levels anymore */
5086     if (pcbddc->benign_have_null && isbddc) {
5087       PC        coarse_pc;
5088       PC_BDDC*  coarsepcbddc;
5089 
5090       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5091       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5092       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5093       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5094     }
5095     if (nullsp) {
5096       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5097     }
5098   }
5099 
5100   /* Local solution on R nodes */
5101   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5102     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5103   }
5104   /* communications from coarse sol to local primal nodes */
5105   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5106   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5107 
5108   /* Sum contributions from the two levels */
5109   if (!pcbddc->benign_apply_coarse_only) {
5110     if (applytranspose) {
5111       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5112       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5113     } else {
5114       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5115       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5116     }
5117     /* store p0 */
5118     if (pcbddc->benign_n) {
5119       PetscScalar *array;
5120       PetscInt    j;
5121 
5122       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5123       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5124       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5125     }
5126   } else { /* expand the coarse solution */
5127     if (applytranspose) {
5128       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5129     } else {
5130       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5131     }
5132   }
5133   PetscFunctionReturn(0);
5134 }
5135 
5136 #undef __FUNCT__
5137 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5138 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5139 {
5140   PetscErrorCode ierr;
5141   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5142   PetscScalar    *array;
5143   Vec            from,to;
5144 
5145   PetscFunctionBegin;
5146   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5147     from = pcbddc->coarse_vec;
5148     to = pcbddc->vec1_P;
5149     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5150       Vec tvec;
5151 
5152       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5153       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5154       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5155       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5156       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5157       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5158     }
5159   } else { /* from local to global -> put data in coarse right hand side */
5160     from = pcbddc->vec1_P;
5161     to = pcbddc->coarse_vec;
5162   }
5163   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5164   PetscFunctionReturn(0);
5165 }
5166 
5167 #undef __FUNCT__
5168 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5169 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5170 {
5171   PetscErrorCode ierr;
5172   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5173   PetscScalar    *array;
5174   Vec            from,to;
5175 
5176   PetscFunctionBegin;
5177   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5178     from = pcbddc->coarse_vec;
5179     to = pcbddc->vec1_P;
5180   } else { /* from local to global -> put data in coarse right hand side */
5181     from = pcbddc->vec1_P;
5182     to = pcbddc->coarse_vec;
5183   }
5184   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5185   if (smode == SCATTER_FORWARD) {
5186     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5187       Vec tvec;
5188 
5189       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5190       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5191       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5192       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5193     }
5194   } else {
5195     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5196      ierr = VecResetArray(from);CHKERRQ(ierr);
5197     }
5198   }
5199   PetscFunctionReturn(0);
5200 }
5201 
5202 /* uncomment for testing purposes */
5203 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5204 #undef __FUNCT__
5205 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5206 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5207 {
5208   PetscErrorCode    ierr;
5209   PC_IS*            pcis = (PC_IS*)(pc->data);
5210   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5211   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5212   /* one and zero */
5213   PetscScalar       one=1.0,zero=0.0;
5214   /* space to store constraints and their local indices */
5215   PetscScalar       *constraints_data;
5216   PetscInt          *constraints_idxs,*constraints_idxs_B;
5217   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5218   PetscInt          *constraints_n;
5219   /* iterators */
5220   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5221   /* BLAS integers */
5222   PetscBLASInt      lwork,lierr;
5223   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5224   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5225   /* reuse */
5226   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5227   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5228   /* change of basis */
5229   PetscBool         qr_needed;
5230   PetscBT           change_basis,qr_needed_idx;
5231   /* auxiliary stuff */
5232   PetscInt          *nnz,*is_indices;
5233   PetscInt          ncc;
5234   /* some quantities */
5235   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5236   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5237 
5238   PetscFunctionBegin;
5239   /* Destroy Mat objects computed previously */
5240   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5241   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5242   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5243   /* save info on constraints from previous setup (if any) */
5244   olocal_primal_size = pcbddc->local_primal_size;
5245   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5246   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5247   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5248   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5249   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5250   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5251 
5252   if (!pcbddc->adaptive_selection) {
5253     IS           ISForVertices,*ISForFaces,*ISForEdges;
5254     MatNullSpace nearnullsp;
5255     const Vec    *nearnullvecs;
5256     Vec          *localnearnullsp;
5257     PetscScalar  *array;
5258     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5259     PetscBool    nnsp_has_cnst;
5260     /* LAPACK working arrays for SVD or POD */
5261     PetscBool    skip_lapack,boolforchange;
5262     PetscScalar  *work;
5263     PetscReal    *singular_vals;
5264 #if defined(PETSC_USE_COMPLEX)
5265     PetscReal    *rwork;
5266 #endif
5267 #if defined(PETSC_MISSING_LAPACK_GESVD)
5268     PetscScalar  *temp_basis,*correlation_mat;
5269 #else
5270     PetscBLASInt dummy_int=1;
5271     PetscScalar  dummy_scalar=1.;
5272 #endif
5273 
5274     /* Get index sets for faces, edges and vertices from graph */
5275     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5276     /* print some info */
5277     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5278       PetscInt nv;
5279 
5280       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5281       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5282       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5283       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5284       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5285       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5286       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5287       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5288       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5289     }
5290 
5291     /* free unneeded index sets */
5292     if (!pcbddc->use_vertices) {
5293       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5294     }
5295     if (!pcbddc->use_edges) {
5296       for (i=0;i<n_ISForEdges;i++) {
5297         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5298       }
5299       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5300       n_ISForEdges = 0;
5301     }
5302     if (!pcbddc->use_faces) {
5303       for (i=0;i<n_ISForFaces;i++) {
5304         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5305       }
5306       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5307       n_ISForFaces = 0;
5308     }
5309 
5310     /* check if near null space is attached to global mat */
5311     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5312     if (nearnullsp) {
5313       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5314       /* remove any stored info */
5315       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5316       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5317       /* store information for BDDC solver reuse */
5318       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5319       pcbddc->onearnullspace = nearnullsp;
5320       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5321       for (i=0;i<nnsp_size;i++) {
5322         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5323       }
5324     } else { /* if near null space is not provided BDDC uses constants by default */
5325       nnsp_size = 0;
5326       nnsp_has_cnst = PETSC_TRUE;
5327     }
5328     /* get max number of constraints on a single cc */
5329     max_constraints = nnsp_size;
5330     if (nnsp_has_cnst) max_constraints++;
5331 
5332     /*
5333          Evaluate maximum storage size needed by the procedure
5334          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5335          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5336          There can be multiple constraints per connected component
5337                                                                                                                                                            */
5338     n_vertices = 0;
5339     if (ISForVertices) {
5340       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5341     }
5342     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5343     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5344 
5345     total_counts = n_ISForFaces+n_ISForEdges;
5346     total_counts *= max_constraints;
5347     total_counts += n_vertices;
5348     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5349 
5350     total_counts = 0;
5351     max_size_of_constraint = 0;
5352     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5353       IS used_is;
5354       if (i<n_ISForEdges) {
5355         used_is = ISForEdges[i];
5356       } else {
5357         used_is = ISForFaces[i-n_ISForEdges];
5358       }
5359       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5360       total_counts += j;
5361       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5362     }
5363     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);
5364 
5365     /* get local part of global near null space vectors */
5366     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5367     for (k=0;k<nnsp_size;k++) {
5368       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5369       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5370       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5371     }
5372 
5373     /* whether or not to skip lapack calls */
5374     skip_lapack = PETSC_TRUE;
5375     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5376 
5377     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5378     if (!skip_lapack) {
5379       PetscScalar temp_work;
5380 
5381 #if defined(PETSC_MISSING_LAPACK_GESVD)
5382       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5383       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5384       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5385       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5386 #if defined(PETSC_USE_COMPLEX)
5387       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5388 #endif
5389       /* now we evaluate the optimal workspace using query with lwork=-1 */
5390       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5391       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5392       lwork = -1;
5393       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5394 #if !defined(PETSC_USE_COMPLEX)
5395       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5396 #else
5397       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5398 #endif
5399       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5400       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5401 #else /* on missing GESVD */
5402       /* SVD */
5403       PetscInt max_n,min_n;
5404       max_n = max_size_of_constraint;
5405       min_n = max_constraints;
5406       if (max_size_of_constraint < max_constraints) {
5407         min_n = max_size_of_constraint;
5408         max_n = max_constraints;
5409       }
5410       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5411 #if defined(PETSC_USE_COMPLEX)
5412       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5413 #endif
5414       /* now we evaluate the optimal workspace using query with lwork=-1 */
5415       lwork = -1;
5416       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5417       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5418       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5419       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5420 #if !defined(PETSC_USE_COMPLEX)
5421       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
5422 #else
5423       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));
5424 #endif
5425       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5426       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5427 #endif /* on missing GESVD */
5428       /* Allocate optimal workspace */
5429       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5430       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5431     }
5432     /* Now we can loop on constraining sets */
5433     total_counts = 0;
5434     constraints_idxs_ptr[0] = 0;
5435     constraints_data_ptr[0] = 0;
5436     /* vertices */
5437     if (n_vertices) {
5438       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5439       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5440       for (i=0;i<n_vertices;i++) {
5441         constraints_n[total_counts] = 1;
5442         constraints_data[total_counts] = 1.0;
5443         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5444         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5445         total_counts++;
5446       }
5447       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5448       n_vertices = total_counts;
5449     }
5450 
5451     /* edges and faces */
5452     total_counts_cc = total_counts;
5453     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5454       IS        used_is;
5455       PetscBool idxs_copied = PETSC_FALSE;
5456 
5457       if (ncc<n_ISForEdges) {
5458         used_is = ISForEdges[ncc];
5459         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5460       } else {
5461         used_is = ISForFaces[ncc-n_ISForEdges];
5462         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5463       }
5464       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5465 
5466       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5467       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5468       /* change of basis should not be performed on local periodic nodes */
5469       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5470       if (nnsp_has_cnst) {
5471         PetscScalar quad_value;
5472 
5473         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5474         idxs_copied = PETSC_TRUE;
5475 
5476         if (!pcbddc->use_nnsp_true) {
5477           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5478         } else {
5479           quad_value = 1.0;
5480         }
5481         for (j=0;j<size_of_constraint;j++) {
5482           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5483         }
5484         temp_constraints++;
5485         total_counts++;
5486       }
5487       for (k=0;k<nnsp_size;k++) {
5488         PetscReal real_value;
5489         PetscScalar *ptr_to_data;
5490 
5491         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5492         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5493         for (j=0;j<size_of_constraint;j++) {
5494           ptr_to_data[j] = array[is_indices[j]];
5495         }
5496         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5497         /* check if array is null on the connected component */
5498         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5499         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5500         if (real_value > 0.0) { /* keep indices and values */
5501           temp_constraints++;
5502           total_counts++;
5503           if (!idxs_copied) {
5504             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5505             idxs_copied = PETSC_TRUE;
5506           }
5507         }
5508       }
5509       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5510       valid_constraints = temp_constraints;
5511       if (!pcbddc->use_nnsp_true && temp_constraints) {
5512         if (temp_constraints == 1) { /* just normalize the constraint */
5513           PetscScalar norm,*ptr_to_data;
5514 
5515           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5516           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5517           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5518           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5519           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5520         } else { /* perform SVD */
5521           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5522           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5523 
5524 #if defined(PETSC_MISSING_LAPACK_GESVD)
5525           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5526              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5527              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5528                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5529                 from that computed using LAPACKgesvd
5530              -> This is due to a different computation of eigenvectors in LAPACKheev
5531              -> The quality of the POD-computed basis will be the same */
5532           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5533           /* Store upper triangular part of correlation matrix */
5534           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5535           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5536           for (j=0;j<temp_constraints;j++) {
5537             for (k=0;k<j+1;k++) {
5538               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));
5539             }
5540           }
5541           /* compute eigenvalues and eigenvectors of correlation matrix */
5542           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5543           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5544 #if !defined(PETSC_USE_COMPLEX)
5545           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5546 #else
5547           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5548 #endif
5549           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5550           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5551           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5552           j = 0;
5553           while (j < temp_constraints && singular_vals[j] < tol) j++;
5554           total_counts = total_counts-j;
5555           valid_constraints = temp_constraints-j;
5556           /* scale and copy POD basis into used quadrature memory */
5557           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5558           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5559           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5560           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5561           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5562           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5563           if (j<temp_constraints) {
5564             PetscInt ii;
5565             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5566             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5567             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));
5568             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5569             for (k=0;k<temp_constraints-j;k++) {
5570               for (ii=0;ii<size_of_constraint;ii++) {
5571                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5572               }
5573             }
5574           }
5575 #else  /* on missing GESVD */
5576           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5577           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5578           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5579           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5580 #if !defined(PETSC_USE_COMPLEX)
5581           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
5582 #else
5583           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));
5584 #endif
5585           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5586           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5587           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5588           k = temp_constraints;
5589           if (k > size_of_constraint) k = size_of_constraint;
5590           j = 0;
5591           while (j < k && singular_vals[k-j-1] < tol) j++;
5592           valid_constraints = k-j;
5593           total_counts = total_counts-temp_constraints+valid_constraints;
5594 #endif /* on missing GESVD */
5595         }
5596       }
5597       /* update pointers information */
5598       if (valid_constraints) {
5599         constraints_n[total_counts_cc] = valid_constraints;
5600         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5601         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5602         /* set change_of_basis flag */
5603         if (boolforchange) {
5604           PetscBTSet(change_basis,total_counts_cc);
5605         }
5606         total_counts_cc++;
5607       }
5608     }
5609     /* free workspace */
5610     if (!skip_lapack) {
5611       ierr = PetscFree(work);CHKERRQ(ierr);
5612 #if defined(PETSC_USE_COMPLEX)
5613       ierr = PetscFree(rwork);CHKERRQ(ierr);
5614 #endif
5615       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5616 #if defined(PETSC_MISSING_LAPACK_GESVD)
5617       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5618       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5619 #endif
5620     }
5621     for (k=0;k<nnsp_size;k++) {
5622       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5623     }
5624     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5625     /* free index sets of faces, edges and vertices */
5626     for (i=0;i<n_ISForFaces;i++) {
5627       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5628     }
5629     if (n_ISForFaces) {
5630       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5631     }
5632     for (i=0;i<n_ISForEdges;i++) {
5633       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5634     }
5635     if (n_ISForEdges) {
5636       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5637     }
5638     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5639   } else {
5640     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5641 
5642     total_counts = 0;
5643     n_vertices = 0;
5644     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5645       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5646     }
5647     max_constraints = 0;
5648     total_counts_cc = 0;
5649     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5650       total_counts += pcbddc->adaptive_constraints_n[i];
5651       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5652       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5653     }
5654     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5655     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5656     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5657     constraints_data = pcbddc->adaptive_constraints_data;
5658     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5659     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5660     total_counts_cc = 0;
5661     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5662       if (pcbddc->adaptive_constraints_n[i]) {
5663         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5664       }
5665     }
5666 #if 0
5667     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5668     for (i=0;i<total_counts_cc;i++) {
5669       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5670       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5671       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5672         printf(" %d",constraints_idxs[j]);
5673       }
5674       printf("\n");
5675       printf("number of cc: %d\n",constraints_n[i]);
5676     }
5677     for (i=0;i<n_vertices;i++) {
5678       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5679     }
5680     for (i=0;i<sub_schurs->n_subs;i++) {
5681       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]);
5682     }
5683 #endif
5684 
5685     max_size_of_constraint = 0;
5686     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]);
5687     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5688     /* Change of basis */
5689     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5690     if (pcbddc->use_change_of_basis) {
5691       for (i=0;i<sub_schurs->n_subs;i++) {
5692         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5693           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5694         }
5695       }
5696     }
5697   }
5698   pcbddc->local_primal_size = total_counts;
5699   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5700 
5701   /* map constraints_idxs in boundary numbering */
5702   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5703   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);
5704 
5705   /* Create constraint matrix */
5706   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5707   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5708   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5709 
5710   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5711   /* determine if a QR strategy is needed for change of basis */
5712   qr_needed = PETSC_FALSE;
5713   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5714   total_primal_vertices=0;
5715   pcbddc->local_primal_size_cc = 0;
5716   for (i=0;i<total_counts_cc;i++) {
5717     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5718     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5719       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5720       pcbddc->local_primal_size_cc += 1;
5721     } else if (PetscBTLookup(change_basis,i)) {
5722       for (k=0;k<constraints_n[i];k++) {
5723         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5724       }
5725       pcbddc->local_primal_size_cc += constraints_n[i];
5726       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5727         PetscBTSet(qr_needed_idx,i);
5728         qr_needed = PETSC_TRUE;
5729       }
5730     } else {
5731       pcbddc->local_primal_size_cc += 1;
5732     }
5733   }
5734   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5735   pcbddc->n_vertices = total_primal_vertices;
5736   /* permute indices in order to have a sorted set of vertices */
5737   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5738   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);
5739   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5740   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5741 
5742   /* nonzero structure of constraint matrix */
5743   /* and get reference dof for local constraints */
5744   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5745   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5746 
5747   j = total_primal_vertices;
5748   total_counts = total_primal_vertices;
5749   cum = total_primal_vertices;
5750   for (i=n_vertices;i<total_counts_cc;i++) {
5751     if (!PetscBTLookup(change_basis,i)) {
5752       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5753       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5754       cum++;
5755       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5756       for (k=0;k<constraints_n[i];k++) {
5757         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5758         nnz[j+k] = size_of_constraint;
5759       }
5760       j += constraints_n[i];
5761     }
5762   }
5763   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5764   ierr = PetscFree(nnz);CHKERRQ(ierr);
5765 
5766   /* set values in constraint matrix */
5767   for (i=0;i<total_primal_vertices;i++) {
5768     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5769   }
5770   total_counts = total_primal_vertices;
5771   for (i=n_vertices;i<total_counts_cc;i++) {
5772     if (!PetscBTLookup(change_basis,i)) {
5773       PetscInt *cols;
5774 
5775       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5776       cols = constraints_idxs+constraints_idxs_ptr[i];
5777       for (k=0;k<constraints_n[i];k++) {
5778         PetscInt    row = total_counts+k;
5779         PetscScalar *vals;
5780 
5781         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5782         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5783       }
5784       total_counts += constraints_n[i];
5785     }
5786   }
5787   /* assembling */
5788   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5789   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5790 
5791   /*
5792   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5793   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5794   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5795   */
5796   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5797   if (pcbddc->use_change_of_basis) {
5798     /* dual and primal dofs on a single cc */
5799     PetscInt     dual_dofs,primal_dofs;
5800     /* working stuff for GEQRF */
5801     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5802     PetscBLASInt lqr_work;
5803     /* working stuff for UNGQR */
5804     PetscScalar  *gqr_work,lgqr_work_t;
5805     PetscBLASInt lgqr_work;
5806     /* working stuff for TRTRS */
5807     PetscScalar  *trs_rhs;
5808     PetscBLASInt Blas_NRHS;
5809     /* pointers for values insertion into change of basis matrix */
5810     PetscInt     *start_rows,*start_cols;
5811     PetscScalar  *start_vals;
5812     /* working stuff for values insertion */
5813     PetscBT      is_primal;
5814     PetscInt     *aux_primal_numbering_B;
5815     /* matrix sizes */
5816     PetscInt     global_size,local_size;
5817     /* temporary change of basis */
5818     Mat          localChangeOfBasisMatrix;
5819     /* extra space for debugging */
5820     PetscScalar  *dbg_work;
5821 
5822     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5823     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5824     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5825     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5826     /* nonzeros for local mat */
5827     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5828     if (!pcbddc->benign_change || pcbddc->fake_change) {
5829       for (i=0;i<pcis->n;i++) nnz[i]=1;
5830     } else {
5831       const PetscInt *ii;
5832       PetscInt       n;
5833       PetscBool      flg_row;
5834       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5835       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5836       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5837     }
5838     for (i=n_vertices;i<total_counts_cc;i++) {
5839       if (PetscBTLookup(change_basis,i)) {
5840         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5841         if (PetscBTLookup(qr_needed_idx,i)) {
5842           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5843         } else {
5844           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5845           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5846         }
5847       }
5848     }
5849     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5850     ierr = PetscFree(nnz);CHKERRQ(ierr);
5851     /* Set interior change in the matrix */
5852     if (!pcbddc->benign_change || pcbddc->fake_change) {
5853       for (i=0;i<pcis->n;i++) {
5854         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5855       }
5856     } else {
5857       const PetscInt *ii,*jj;
5858       PetscScalar    *aa;
5859       PetscInt       n;
5860       PetscBool      flg_row;
5861       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5862       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5863       for (i=0;i<n;i++) {
5864         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5865       }
5866       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5867       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5868     }
5869 
5870     if (pcbddc->dbg_flag) {
5871       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5872       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5873     }
5874 
5875 
5876     /* Now we loop on the constraints which need a change of basis */
5877     /*
5878        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5879        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5880 
5881        Basic blocks of change of basis matrix T computed by
5882 
5883           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5884 
5885             | 1        0   ...        0         s_1/S |
5886             | 0        1   ...        0         s_2/S |
5887             |              ...                        |
5888             | 0        ...            1     s_{n-1}/S |
5889             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5890 
5891             with S = \sum_{i=1}^n s_i^2
5892             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5893                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5894 
5895           - QR decomposition of constraints otherwise
5896     */
5897     if (qr_needed) {
5898       /* space to store Q */
5899       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5900       /* array to store scaling factors for reflectors */
5901       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5902       /* first we issue queries for optimal work */
5903       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5904       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5905       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5906       lqr_work = -1;
5907       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5908       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5909       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5910       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5911       lgqr_work = -1;
5912       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5913       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5914       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5915       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5916       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5917       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5918       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5919       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5920       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5921       /* array to store rhs and solution of triangular solver */
5922       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5923       /* allocating workspace for check */
5924       if (pcbddc->dbg_flag) {
5925         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5926       }
5927     }
5928     /* array to store whether a node is primal or not */
5929     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5930     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5931     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5932     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);
5933     for (i=0;i<total_primal_vertices;i++) {
5934       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5935     }
5936     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5937 
5938     /* loop on constraints and see whether or not they need a change of basis and compute it */
5939     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5940       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5941       if (PetscBTLookup(change_basis,total_counts)) {
5942         /* get constraint info */
5943         primal_dofs = constraints_n[total_counts];
5944         dual_dofs = size_of_constraint-primal_dofs;
5945 
5946         if (pcbddc->dbg_flag) {
5947           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);
5948         }
5949 
5950         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5951 
5952           /* copy quadrature constraints for change of basis check */
5953           if (pcbddc->dbg_flag) {
5954             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5955           }
5956           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5957           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5958 
5959           /* compute QR decomposition of constraints */
5960           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5961           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5962           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5963           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5964           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5965           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5966           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5967 
5968           /* explictly compute R^-T */
5969           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5970           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5971           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5972           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5973           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5974           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5975           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5976           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5977           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5978           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5979 
5980           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5981           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5982           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5983           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5984           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5985           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5986           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5987           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5988           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5989 
5990           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5991              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5992              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5993           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5994           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5995           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5996           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5997           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5998           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5999           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6000           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));
6001           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6002           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6003 
6004           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6005           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6006           /* insert cols for primal dofs */
6007           for (j=0;j<primal_dofs;j++) {
6008             start_vals = &qr_basis[j*size_of_constraint];
6009             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6010             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6011           }
6012           /* insert cols for dual dofs */
6013           for (j=0,k=0;j<dual_dofs;k++) {
6014             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6015               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6016               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6017               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6018               j++;
6019             }
6020           }
6021 
6022           /* check change of basis */
6023           if (pcbddc->dbg_flag) {
6024             PetscInt   ii,jj;
6025             PetscBool valid_qr=PETSC_TRUE;
6026             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6027             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6028             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6029             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6030             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6031             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6032             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6033             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));
6034             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6035             for (jj=0;jj<size_of_constraint;jj++) {
6036               for (ii=0;ii<primal_dofs;ii++) {
6037                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6038                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6039               }
6040             }
6041             if (!valid_qr) {
6042               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6043               for (jj=0;jj<size_of_constraint;jj++) {
6044                 for (ii=0;ii<primal_dofs;ii++) {
6045                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6046                     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]));
6047                   }
6048                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6049                     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]));
6050                   }
6051                 }
6052               }
6053             } else {
6054               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6055             }
6056           }
6057         } else { /* simple transformation block */
6058           PetscInt    row,col;
6059           PetscScalar val,norm;
6060 
6061           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6062           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6063           for (j=0;j<size_of_constraint;j++) {
6064             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6065             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6066             if (!PetscBTLookup(is_primal,row_B)) {
6067               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6068               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6069               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6070             } else {
6071               for (k=0;k<size_of_constraint;k++) {
6072                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6073                 if (row != col) {
6074                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6075                 } else {
6076                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6077                 }
6078                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6079               }
6080             }
6081           }
6082           if (pcbddc->dbg_flag) {
6083             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6084           }
6085         }
6086       } else {
6087         if (pcbddc->dbg_flag) {
6088           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6089         }
6090       }
6091     }
6092 
6093     /* free workspace */
6094     if (qr_needed) {
6095       if (pcbddc->dbg_flag) {
6096         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6097       }
6098       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6099       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6100       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6101       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6102       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6103     }
6104     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6105     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6106     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6107 
6108     /* assembling of global change of variable */
6109     if (!pcbddc->fake_change) {
6110       Mat      tmat;
6111       PetscInt bs;
6112 
6113       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6114       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6115       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6116       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6117       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6118       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6119       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6120       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6121       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6122       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6123       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6124       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6125       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6126       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6127       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6128       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6129       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6130       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6131 
6132       /* check */
6133       if (pcbddc->dbg_flag) {
6134         PetscReal error;
6135         Vec       x,x_change;
6136 
6137         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6138         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6139         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6140         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6141         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6142         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6143         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6144         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6145         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6146         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6147         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6148         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6149         if (error > PETSC_SMALL) {
6150           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6151         }
6152         ierr = VecDestroy(&x);CHKERRQ(ierr);
6153         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6154       }
6155       /* adapt sub_schurs computed (if any) */
6156       if (pcbddc->use_deluxe_scaling) {
6157         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6158 
6159         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);
6160         if (sub_schurs && sub_schurs->S_Ej_all) {
6161           Mat                    S_new,tmat;
6162           IS                     is_all_N,is_V_Sall = NULL;
6163 
6164           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6165           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6166           if (pcbddc->deluxe_zerorows) {
6167             ISLocalToGlobalMapping NtoSall;
6168             IS                     is_V;
6169             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6170             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6171             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6172             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6173             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6174           }
6175           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6176           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6177           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6178           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6179           if (pcbddc->deluxe_zerorows) {
6180             const PetscScalar *array;
6181             const PetscInt    *idxs_V,*idxs_all;
6182             PetscInt          i,n_V;
6183 
6184             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6185             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6186             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6187             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6188             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6189             for (i=0;i<n_V;i++) {
6190               PetscScalar val;
6191               PetscInt    idx;
6192 
6193               idx = idxs_V[i];
6194               val = array[idxs_all[idxs_V[i]]];
6195               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6196             }
6197             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6198             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6199             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6200             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6201             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6202           }
6203           sub_schurs->S_Ej_all = S_new;
6204           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6205           if (sub_schurs->sum_S_Ej_all) {
6206             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6207             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6208             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6209             if (pcbddc->deluxe_zerorows) {
6210               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6211             }
6212             sub_schurs->sum_S_Ej_all = S_new;
6213             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6214           }
6215           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6216           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6217         }
6218         /* destroy any change of basis context in sub_schurs */
6219         if (sub_schurs && sub_schurs->change) {
6220           PetscInt i;
6221 
6222           for (i=0;i<sub_schurs->n_subs;i++) {
6223             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6224           }
6225           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6226         }
6227       }
6228       if (pcbddc->switch_static) { /* need to save the local change */
6229         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6230       } else {
6231         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6232       }
6233       /* determine if any process has changed the pressures locally */
6234       pcbddc->change_interior = pcbddc->benign_have_null;
6235     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6236       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6237       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6238       pcbddc->use_qr_single = qr_needed;
6239     }
6240   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6241     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6242       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6243       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6244     } else {
6245       Mat benign_global = NULL;
6246       if (pcbddc->benign_have_null) {
6247         Mat tmat;
6248 
6249         pcbddc->change_interior = PETSC_TRUE;
6250         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6251         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6252         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6253         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6254         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6255         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6256         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6257         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6258         if (pcbddc->benign_change) {
6259           Mat M;
6260 
6261           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6262           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6263           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6264           ierr = MatDestroy(&M);CHKERRQ(ierr);
6265         } else {
6266           Mat         eye;
6267           PetscScalar *array;
6268 
6269           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6270           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6271           for (i=0;i<pcis->n;i++) {
6272             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6273           }
6274           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6275           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6276           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6277           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6278           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6279         }
6280         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6281         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6282       }
6283       if (pcbddc->user_ChangeOfBasisMatrix) {
6284         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6285         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6286       } else if (pcbddc->benign_have_null) {
6287         pcbddc->ChangeOfBasisMatrix = benign_global;
6288       }
6289     }
6290     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6291       IS             is_global;
6292       const PetscInt *gidxs;
6293 
6294       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6295       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6296       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6297       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6298       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6299     }
6300   }
6301   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6302     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6303   }
6304 
6305   if (!pcbddc->fake_change) {
6306     /* add pressure dofs to set of primal nodes for numbering purposes */
6307     for (i=0;i<pcbddc->benign_n;i++) {
6308       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6309       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6310       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6311       pcbddc->local_primal_size_cc++;
6312       pcbddc->local_primal_size++;
6313     }
6314 
6315     /* check if a new primal space has been introduced (also take into account benign trick) */
6316     pcbddc->new_primal_space_local = PETSC_TRUE;
6317     if (olocal_primal_size == pcbddc->local_primal_size) {
6318       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6319       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6320       if (!pcbddc->new_primal_space_local) {
6321         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6322         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6323       }
6324     }
6325     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6326     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6327   }
6328   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6329 
6330   /* flush dbg viewer */
6331   if (pcbddc->dbg_flag) {
6332     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6333   }
6334 
6335   /* free workspace */
6336   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6337   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6338   if (!pcbddc->adaptive_selection) {
6339     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6340     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6341   } else {
6342     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6343                       pcbddc->adaptive_constraints_idxs_ptr,
6344                       pcbddc->adaptive_constraints_data_ptr,
6345                       pcbddc->adaptive_constraints_idxs,
6346                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6347     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6348     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6349   }
6350   PetscFunctionReturn(0);
6351 }
6352 
6353 #undef __FUNCT__
6354 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6355 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6356 {
6357   ISLocalToGlobalMapping map;
6358   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6359   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6360   PetscInt               i,N;
6361   PetscBool              rcsr = PETSC_FALSE;
6362   PetscErrorCode         ierr;
6363 
6364   PetscFunctionBegin;
6365   if (pcbddc->recompute_topography) {
6366     pcbddc->graphanalyzed = PETSC_FALSE;
6367     /* Reset previously computed graph */
6368     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6369     /* Init local Graph struct */
6370     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6371     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6372     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6373 
6374     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6375       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6376     }
6377     /* Check validity of the csr graph passed in by the user */
6378     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);
6379 
6380     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6381     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6382       PetscInt  *xadj,*adjncy;
6383       PetscInt  nvtxs;
6384       PetscBool flg_row=PETSC_FALSE;
6385 
6386       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6387       if (flg_row) {
6388         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6389         pcbddc->computed_rowadj = PETSC_TRUE;
6390       }
6391       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6392       rcsr = PETSC_TRUE;
6393     }
6394     if (pcbddc->dbg_flag) {
6395       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6396     }
6397 
6398     /* Setup of Graph */
6399     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6400     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6401 
6402     /* attach info on disconnected subdomains if present */
6403     if (pcbddc->n_local_subs) {
6404       PetscInt *local_subs;
6405 
6406       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6407       for (i=0;i<pcbddc->n_local_subs;i++) {
6408         const PetscInt *idxs;
6409         PetscInt       nl,j;
6410 
6411         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6412         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6413         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6414         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6415       }
6416       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6417       pcbddc->mat_graph->local_subs = local_subs;
6418     }
6419   }
6420 
6421   if (!pcbddc->graphanalyzed) {
6422     /* Graph's connected components analysis */
6423     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6424     pcbddc->graphanalyzed = PETSC_TRUE;
6425   }
6426   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6427   PetscFunctionReturn(0);
6428 }
6429 
6430 #undef __FUNCT__
6431 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6432 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6433 {
6434   PetscInt       i,j;
6435   PetscScalar    *alphas;
6436   PetscErrorCode ierr;
6437 
6438   PetscFunctionBegin;
6439   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6440   for (i=0;i<n;i++) {
6441     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6442     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6443     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6444     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6445   }
6446   ierr = PetscFree(alphas);CHKERRQ(ierr);
6447   PetscFunctionReturn(0);
6448 }
6449 
6450 #undef __FUNCT__
6451 #define __FUNCT__ "PCBDDCMatISGetSubassemblingPattern"
6452 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6453 {
6454   Mat            A;
6455   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6456   PetscMPIInt    size,rank,color;
6457   PetscInt       *xadj,*adjncy;
6458   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6459   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6460   PetscInt       void_procs,*procs_candidates = NULL;
6461   PetscInt       xadj_count,*count;
6462   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6463   PetscSubcomm   psubcomm;
6464   MPI_Comm       subcomm;
6465   PetscErrorCode ierr;
6466 
6467   PetscFunctionBegin;
6468   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6469   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6470   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6471   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6472   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6473   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6474 
6475   if (have_void) *have_void = PETSC_FALSE;
6476   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6477   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6478   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6479   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6480   im_active = !!n;
6481   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6482   void_procs = size - active_procs;
6483   /* get ranks of of non-active processes in mat communicator */
6484   if (void_procs) {
6485     PetscInt ncand;
6486 
6487     if (have_void) *have_void = PETSC_TRUE;
6488     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6489     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6490     for (i=0,ncand=0;i<size;i++) {
6491       if (!procs_candidates[i]) {
6492         procs_candidates[ncand++] = i;
6493       }
6494     }
6495     /* force n_subdomains to be not greater that the number of non-active processes */
6496     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6497   }
6498 
6499   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6500      number of subdomains requested 1 -> send to master or first candidate in voids  */
6501   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6502   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6503     PetscInt issize,isidx,dest;
6504     if (*n_subdomains == 1) dest = 0;
6505     else dest = rank;
6506     if (im_active) {
6507       issize = 1;
6508       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6509         isidx = procs_candidates[dest];
6510       } else {
6511         isidx = dest;
6512       }
6513     } else {
6514       issize = 0;
6515       isidx = -1;
6516     }
6517     if (*n_subdomains != 1) *n_subdomains = active_procs;
6518     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6519     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6520     PetscFunctionReturn(0);
6521   }
6522   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6523   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6524   threshold = PetscMax(threshold,2);
6525 
6526   /* Get info on mapping */
6527   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6528 
6529   /* build local CSR graph of subdomains' connectivity */
6530   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6531   xadj[0] = 0;
6532   xadj[1] = PetscMax(n_neighs-1,0);
6533   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6534   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6535   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6536   for (i=1;i<n_neighs;i++)
6537     for (j=0;j<n_shared[i];j++)
6538       count[shared[i][j]] += 1;
6539 
6540   xadj_count = 0;
6541   for (i=1;i<n_neighs;i++) {
6542     for (j=0;j<n_shared[i];j++) {
6543       if (count[shared[i][j]] < threshold) {
6544         adjncy[xadj_count] = neighs[i];
6545         adjncy_wgt[xadj_count] = n_shared[i];
6546         xadj_count++;
6547         break;
6548       }
6549     }
6550   }
6551   xadj[1] = xadj_count;
6552   ierr = PetscFree(count);CHKERRQ(ierr);
6553   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6554   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6555 
6556   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6557 
6558   /* Restrict work on active processes only */
6559   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6560   if (void_procs) {
6561     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6562     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6563     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6564     subcomm = PetscSubcommChild(psubcomm);
6565   } else {
6566     psubcomm = NULL;
6567     subcomm = PetscObjectComm((PetscObject)mat);
6568   }
6569 
6570   v_wgt = NULL;
6571   if (!color) {
6572     ierr = PetscFree(xadj);CHKERRQ(ierr);
6573     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6574     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6575   } else {
6576     Mat             subdomain_adj;
6577     IS              new_ranks,new_ranks_contig;
6578     MatPartitioning partitioner;
6579     PetscInt        rstart=0,rend=0;
6580     PetscInt        *is_indices,*oldranks;
6581     PetscMPIInt     size;
6582     PetscBool       aggregate;
6583 
6584     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6585     if (void_procs) {
6586       PetscInt prank = rank;
6587       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6588       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6589       for (i=0;i<xadj[1];i++) {
6590         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6591       }
6592       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6593     } else {
6594       oldranks = NULL;
6595     }
6596     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6597     if (aggregate) { /* TODO: all this part could be made more efficient */
6598       PetscInt    lrows,row,ncols,*cols;
6599       PetscMPIInt nrank;
6600       PetscScalar *vals;
6601 
6602       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6603       lrows = 0;
6604       if (nrank<redprocs) {
6605         lrows = size/redprocs;
6606         if (nrank<size%redprocs) lrows++;
6607       }
6608       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6609       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6610       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6611       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6612       row = nrank;
6613       ncols = xadj[1]-xadj[0];
6614       cols = adjncy;
6615       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6616       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6617       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6618       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6619       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6620       ierr = PetscFree(xadj);CHKERRQ(ierr);
6621       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6622       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6623       ierr = PetscFree(vals);CHKERRQ(ierr);
6624       if (use_vwgt) {
6625         Vec               v;
6626         const PetscScalar *array;
6627         PetscInt          nl;
6628 
6629         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6630         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6631         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6632         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6633         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6634         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6635         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6636         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6637         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6638         ierr = VecDestroy(&v);CHKERRQ(ierr);
6639       }
6640     } else {
6641       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6642       if (use_vwgt) {
6643         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6644         v_wgt[0] = n;
6645       }
6646     }
6647     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6648 
6649     /* Partition */
6650     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6651     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6652     if (v_wgt) {
6653       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6654     }
6655     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6656     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6657     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6658     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6659     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6660 
6661     /* renumber new_ranks to avoid "holes" in new set of processors */
6662     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6663     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6664     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6665     if (!aggregate) {
6666       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6667 #if defined(PETSC_USE_DEBUG)
6668         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6669 #endif
6670         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6671       } else if (oldranks) {
6672         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6673       } else {
6674         ranks_send_to_idx[0] = is_indices[0];
6675       }
6676     } else {
6677       PetscInt    idxs[1];
6678       PetscMPIInt tag;
6679       MPI_Request *reqs;
6680 
6681       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6682       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6683       for (i=rstart;i<rend;i++) {
6684         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6685       }
6686       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6687       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6688       ierr = PetscFree(reqs);CHKERRQ(ierr);
6689       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6690 #if defined(PETSC_USE_DEBUG)
6691         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6692 #endif
6693         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6694       } else if (oldranks) {
6695         ranks_send_to_idx[0] = oldranks[idxs[0]];
6696       } else {
6697         ranks_send_to_idx[0] = idxs[0];
6698       }
6699     }
6700     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6701     /* clean up */
6702     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6703     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6704     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6705     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6706   }
6707   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6708   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6709 
6710   /* assemble parallel IS for sends */
6711   i = 1;
6712   if (!color) i=0;
6713   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6714   PetscFunctionReturn(0);
6715 }
6716 
6717 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6718 
6719 #undef __FUNCT__
6720 #define __FUNCT__ "PCBDDCMatISSubassemble"
6721 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[])
6722 {
6723   Mat                    local_mat;
6724   IS                     is_sends_internal;
6725   PetscInt               rows,cols,new_local_rows;
6726   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6727   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6728   ISLocalToGlobalMapping l2gmap;
6729   PetscInt*              l2gmap_indices;
6730   const PetscInt*        is_indices;
6731   MatType                new_local_type;
6732   /* buffers */
6733   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6734   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6735   PetscInt               *recv_buffer_idxs_local;
6736   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6737   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6738   /* MPI */
6739   MPI_Comm               comm,comm_n;
6740   PetscSubcomm           subcomm;
6741   PetscMPIInt            n_sends,n_recvs,commsize;
6742   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6743   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6744   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6745   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6746   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6747   PetscErrorCode         ierr;
6748 
6749   PetscFunctionBegin;
6750   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6751   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6752   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6753   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6754   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6755   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6756   PetscValidLogicalCollectiveBool(mat,reuse,6);
6757   PetscValidLogicalCollectiveInt(mat,nis,8);
6758   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6759   if (nvecs) {
6760     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6761     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6762   }
6763   /* further checks */
6764   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6765   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6766   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6767   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6768   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6769   if (reuse && *mat_n) {
6770     PetscInt mrows,mcols,mnrows,mncols;
6771     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6772     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6773     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6774     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6775     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6776     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6777     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6778   }
6779   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6780   PetscValidLogicalCollectiveInt(mat,bs,0);
6781 
6782   /* prepare IS for sending if not provided */
6783   if (!is_sends) {
6784     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6785     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6786   } else {
6787     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6788     is_sends_internal = is_sends;
6789   }
6790 
6791   /* get comm */
6792   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6793 
6794   /* compute number of sends */
6795   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6796   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6797 
6798   /* compute number of receives */
6799   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6800   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6801   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6802   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6803   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6804   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6805   ierr = PetscFree(iflags);CHKERRQ(ierr);
6806 
6807   /* restrict comm if requested */
6808   subcomm = 0;
6809   destroy_mat = PETSC_FALSE;
6810   if (restrict_comm) {
6811     PetscMPIInt color,subcommsize;
6812 
6813     color = 0;
6814     if (restrict_full) {
6815       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6816     } else {
6817       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6818     }
6819     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6820     subcommsize = commsize - subcommsize;
6821     /* check if reuse has been requested */
6822     if (reuse) {
6823       if (*mat_n) {
6824         PetscMPIInt subcommsize2;
6825         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6826         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6827         comm_n = PetscObjectComm((PetscObject)*mat_n);
6828       } else {
6829         comm_n = PETSC_COMM_SELF;
6830       }
6831     } else { /* MAT_INITIAL_MATRIX */
6832       PetscMPIInt rank;
6833 
6834       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6835       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6836       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6837       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6838       comm_n = PetscSubcommChild(subcomm);
6839     }
6840     /* flag to destroy *mat_n if not significative */
6841     if (color) destroy_mat = PETSC_TRUE;
6842   } else {
6843     comm_n = comm;
6844   }
6845 
6846   /* prepare send/receive buffers */
6847   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6848   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6849   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6850   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6851   if (nis) {
6852     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6853   }
6854 
6855   /* Get data from local matrices */
6856   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6857     /* TODO: See below some guidelines on how to prepare the local buffers */
6858     /*
6859        send_buffer_vals should contain the raw values of the local matrix
6860        send_buffer_idxs should contain:
6861        - MatType_PRIVATE type
6862        - PetscInt        size_of_l2gmap
6863        - PetscInt        global_row_indices[size_of_l2gmap]
6864        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6865     */
6866   else {
6867     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6868     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6869     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6870     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6871     send_buffer_idxs[1] = i;
6872     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6873     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6874     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6875     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6876     for (i=0;i<n_sends;i++) {
6877       ilengths_vals[is_indices[i]] = len*len;
6878       ilengths_idxs[is_indices[i]] = len+2;
6879     }
6880   }
6881   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6882   /* additional is (if any) */
6883   if (nis) {
6884     PetscMPIInt psum;
6885     PetscInt j;
6886     for (j=0,psum=0;j<nis;j++) {
6887       PetscInt plen;
6888       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6889       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6890       psum += len+1; /* indices + lenght */
6891     }
6892     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6893     for (j=0,psum=0;j<nis;j++) {
6894       PetscInt plen;
6895       const PetscInt *is_array_idxs;
6896       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6897       send_buffer_idxs_is[psum] = plen;
6898       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6899       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6900       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6901       psum += plen+1; /* indices + lenght */
6902     }
6903     for (i=0;i<n_sends;i++) {
6904       ilengths_idxs_is[is_indices[i]] = psum;
6905     }
6906     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6907   }
6908 
6909   buf_size_idxs = 0;
6910   buf_size_vals = 0;
6911   buf_size_idxs_is = 0;
6912   buf_size_vecs = 0;
6913   for (i=0;i<n_recvs;i++) {
6914     buf_size_idxs += (PetscInt)olengths_idxs[i];
6915     buf_size_vals += (PetscInt)olengths_vals[i];
6916     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6917     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6918   }
6919   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6920   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6921   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6922   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6923 
6924   /* get new tags for clean communications */
6925   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6926   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6927   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6928   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6929 
6930   /* allocate for requests */
6931   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6932   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6933   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6934   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6935   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6936   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6937   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6938   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6939 
6940   /* communications */
6941   ptr_idxs = recv_buffer_idxs;
6942   ptr_vals = recv_buffer_vals;
6943   ptr_idxs_is = recv_buffer_idxs_is;
6944   ptr_vecs = recv_buffer_vecs;
6945   for (i=0;i<n_recvs;i++) {
6946     source_dest = onodes[i];
6947     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6948     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6949     ptr_idxs += olengths_idxs[i];
6950     ptr_vals += olengths_vals[i];
6951     if (nis) {
6952       source_dest = onodes_is[i];
6953       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);
6954       ptr_idxs_is += olengths_idxs_is[i];
6955     }
6956     if (nvecs) {
6957       source_dest = onodes[i];
6958       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6959       ptr_vecs += olengths_idxs[i]-2;
6960     }
6961   }
6962   for (i=0;i<n_sends;i++) {
6963     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6964     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6965     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6966     if (nis) {
6967       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);
6968     }
6969     if (nvecs) {
6970       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6971       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6972     }
6973   }
6974   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6975   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6976 
6977   /* assemble new l2g map */
6978   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6979   ptr_idxs = recv_buffer_idxs;
6980   new_local_rows = 0;
6981   for (i=0;i<n_recvs;i++) {
6982     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6983     ptr_idxs += olengths_idxs[i];
6984   }
6985   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6986   ptr_idxs = recv_buffer_idxs;
6987   new_local_rows = 0;
6988   for (i=0;i<n_recvs;i++) {
6989     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6990     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6991     ptr_idxs += olengths_idxs[i];
6992   }
6993   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6994   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6995   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6996 
6997   /* infer new local matrix type from received local matrices type */
6998   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
6999   /* 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) */
7000   if (n_recvs) {
7001     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7002     ptr_idxs = recv_buffer_idxs;
7003     for (i=0;i<n_recvs;i++) {
7004       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7005         new_local_type_private = MATAIJ_PRIVATE;
7006         break;
7007       }
7008       ptr_idxs += olengths_idxs[i];
7009     }
7010     switch (new_local_type_private) {
7011       case MATDENSE_PRIVATE:
7012         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
7013           new_local_type = MATSEQAIJ;
7014           bs = 1;
7015         } else { /* if I receive only 1 dense matrix */
7016           new_local_type = MATSEQDENSE;
7017           bs = 1;
7018         }
7019         break;
7020       case MATAIJ_PRIVATE:
7021         new_local_type = MATSEQAIJ;
7022         bs = 1;
7023         break;
7024       case MATBAIJ_PRIVATE:
7025         new_local_type = MATSEQBAIJ;
7026         break;
7027       case MATSBAIJ_PRIVATE:
7028         new_local_type = MATSEQSBAIJ;
7029         break;
7030       default:
7031         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
7032         break;
7033     }
7034   } else { /* by default, new_local_type is seqdense */
7035     new_local_type = MATSEQDENSE;
7036     bs = 1;
7037   }
7038 
7039   /* create MATIS object if needed */
7040   if (!reuse) {
7041     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7042     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7043   } else {
7044     /* it also destroys the local matrices */
7045     if (*mat_n) {
7046       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7047     } else { /* this is a fake object */
7048       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7049     }
7050   }
7051   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7052   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7053 
7054   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7055 
7056   /* Global to local map of received indices */
7057   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7058   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7059   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7060 
7061   /* restore attributes -> type of incoming data and its size */
7062   buf_size_idxs = 0;
7063   for (i=0;i<n_recvs;i++) {
7064     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7065     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7066     buf_size_idxs += (PetscInt)olengths_idxs[i];
7067   }
7068   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7069 
7070   /* set preallocation */
7071   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7072   if (!newisdense) {
7073     PetscInt *new_local_nnz=0;
7074 
7075     ptr_idxs = recv_buffer_idxs_local;
7076     if (n_recvs) {
7077       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7078     }
7079     for (i=0;i<n_recvs;i++) {
7080       PetscInt j;
7081       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7082         for (j=0;j<*(ptr_idxs+1);j++) {
7083           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7084         }
7085       } else {
7086         /* TODO */
7087       }
7088       ptr_idxs += olengths_idxs[i];
7089     }
7090     if (new_local_nnz) {
7091       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7092       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7093       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7094       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7095       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7096       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7097     } else {
7098       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7099     }
7100     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7101   } else {
7102     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7103   }
7104 
7105   /* set values */
7106   ptr_vals = recv_buffer_vals;
7107   ptr_idxs = recv_buffer_idxs_local;
7108   for (i=0;i<n_recvs;i++) {
7109     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7110       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7111       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7112       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7113       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7114       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7115     } else {
7116       /* TODO */
7117     }
7118     ptr_idxs += olengths_idxs[i];
7119     ptr_vals += olengths_vals[i];
7120   }
7121   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7122   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7123   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7124   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7125   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7126 
7127 #if 0
7128   if (!restrict_comm) { /* check */
7129     Vec       lvec,rvec;
7130     PetscReal infty_error;
7131 
7132     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7133     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7134     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7135     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7136     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7137     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7138     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7139     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7140     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7141   }
7142 #endif
7143 
7144   /* assemble new additional is (if any) */
7145   if (nis) {
7146     PetscInt **temp_idxs,*count_is,j,psum;
7147 
7148     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7149     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7150     ptr_idxs = recv_buffer_idxs_is;
7151     psum = 0;
7152     for (i=0;i<n_recvs;i++) {
7153       for (j=0;j<nis;j++) {
7154         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7155         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7156         psum += plen;
7157         ptr_idxs += plen+1; /* shift pointer to received data */
7158       }
7159     }
7160     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7161     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7162     for (i=1;i<nis;i++) {
7163       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7164     }
7165     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7166     ptr_idxs = recv_buffer_idxs_is;
7167     for (i=0;i<n_recvs;i++) {
7168       for (j=0;j<nis;j++) {
7169         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7170         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7171         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7172         ptr_idxs += plen+1; /* shift pointer to received data */
7173       }
7174     }
7175     for (i=0;i<nis;i++) {
7176       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7177       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7178       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7179     }
7180     ierr = PetscFree(count_is);CHKERRQ(ierr);
7181     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7182     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7183   }
7184   /* free workspace */
7185   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7186   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7187   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7188   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7189   if (isdense) {
7190     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7191     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7192   } else {
7193     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7194   }
7195   if (nis) {
7196     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7197     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7198   }
7199 
7200   if (nvecs) {
7201     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7202     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7203     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7204     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7205     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7206     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7207     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7208     /* set values */
7209     ptr_vals = recv_buffer_vecs;
7210     ptr_idxs = recv_buffer_idxs_local;
7211     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7212     for (i=0;i<n_recvs;i++) {
7213       PetscInt j;
7214       for (j=0;j<*(ptr_idxs+1);j++) {
7215         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7216       }
7217       ptr_idxs += olengths_idxs[i];
7218       ptr_vals += olengths_idxs[i]-2;
7219     }
7220     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7221     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7222     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7223   }
7224 
7225   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7226   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7227   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7228   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7229   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7230   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7231   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7232   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7233   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7234   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7235   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7236   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7237   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7238   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7239   ierr = PetscFree(onodes);CHKERRQ(ierr);
7240   if (nis) {
7241     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7242     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7243     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7244   }
7245   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7246   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7247     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7248     for (i=0;i<nis;i++) {
7249       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7250     }
7251     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7252       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7253     }
7254     *mat_n = NULL;
7255   }
7256   PetscFunctionReturn(0);
7257 }
7258 
7259 /* temporary hack into ksp private data structure */
7260 #include <petsc/private/kspimpl.h>
7261 
7262 #undef __FUNCT__
7263 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7264 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7265 {
7266   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7267   PC_IS                  *pcis = (PC_IS*)pc->data;
7268   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7269   Mat                    coarsedivudotp = NULL;
7270   Mat                    coarseG,t_coarse_mat_is;
7271   MatNullSpace           CoarseNullSpace = NULL;
7272   ISLocalToGlobalMapping coarse_islg;
7273   IS                     coarse_is,*isarray;
7274   PetscInt               i,im_active=-1,active_procs=-1;
7275   PetscInt               nis,nisdofs,nisneu,nisvert;
7276   PC                     pc_temp;
7277   PCType                 coarse_pc_type;
7278   KSPType                coarse_ksp_type;
7279   PetscBool              multilevel_requested,multilevel_allowed;
7280   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7281   PetscInt               ncoarse,nedcfield;
7282   PetscBool              compute_vecs = PETSC_FALSE;
7283   PetscScalar            *array;
7284   MatReuse               coarse_mat_reuse;
7285   PetscBool              restr, full_restr, have_void;
7286   PetscErrorCode         ierr;
7287 
7288   PetscFunctionBegin;
7289   /* Assign global numbering to coarse dofs */
7290   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 */
7291     PetscInt ocoarse_size;
7292     compute_vecs = PETSC_TRUE;
7293     ocoarse_size = pcbddc->coarse_size;
7294     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7295     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7296     /* see if we can avoid some work */
7297     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7298       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7299       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7300         PC        pc;
7301         PetscBool isbddc;
7302 
7303         /* temporary workaround since PCBDDC does not have a reset method so far */
7304         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7305         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7306         if (isbddc) {
7307           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7308         } else {
7309           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7310         }
7311         coarse_reuse = PETSC_FALSE;
7312       } else { /* we can safely reuse already computed coarse matrix */
7313         coarse_reuse = PETSC_TRUE;
7314       }
7315     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7316       coarse_reuse = PETSC_FALSE;
7317     }
7318     /* reset any subassembling information */
7319     if (!coarse_reuse || pcbddc->recompute_topography) {
7320       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7321     }
7322   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7323     coarse_reuse = PETSC_TRUE;
7324   }
7325   /* assemble coarse matrix */
7326   if (coarse_reuse && pcbddc->coarse_ksp) {
7327     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7328     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7329     coarse_mat_reuse = MAT_REUSE_MATRIX;
7330   } else {
7331     coarse_mat = NULL;
7332     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7333   }
7334 
7335   /* creates temporary l2gmap and IS for coarse indexes */
7336   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7337   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7338 
7339   /* creates temporary MATIS object for coarse matrix */
7340   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7341   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7342   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7343   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7344   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);
7345   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7346   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7347   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7348   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7349 
7350   /* count "active" (i.e. with positive local size) and "void" processes */
7351   im_active = !!(pcis->n);
7352   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7353 
7354   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7355   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7356   /* full_restr : just use the receivers from the subassembling pattern */
7357   coarse_mat_is = NULL;
7358   multilevel_allowed = PETSC_FALSE;
7359   multilevel_requested = PETSC_FALSE;
7360   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7361   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7362   if (multilevel_requested) {
7363     ncoarse = active_procs/pcbddc->coarsening_ratio;
7364     restr = PETSC_FALSE;
7365     full_restr = PETSC_FALSE;
7366   } else {
7367     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7368     restr = PETSC_TRUE;
7369     full_restr = PETSC_TRUE;
7370   }
7371   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7372   ncoarse = PetscMax(1,ncoarse);
7373   if (!pcbddc->coarse_subassembling) {
7374     if (pcbddc->coarsening_ratio > 1) {
7375       if (multilevel_requested) {
7376         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7377       } else {
7378         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7379       }
7380     } else {
7381       PetscMPIInt size,rank;
7382       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7383       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7384       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7385       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7386     }
7387   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7388     PetscInt    psum;
7389     PetscMPIInt size;
7390     if (pcbddc->coarse_ksp) psum = 1;
7391     else psum = 0;
7392     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7393     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7394     if (ncoarse < size) have_void = PETSC_TRUE;
7395   }
7396   /* determine if we can go multilevel */
7397   if (multilevel_requested) {
7398     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7399     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7400   }
7401   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7402 
7403   /* dump subassembling pattern */
7404   if (pcbddc->dbg_flag && multilevel_allowed) {
7405     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7406   }
7407 
7408   /* compute dofs splitting and neumann boundaries for coarse dofs */
7409   nedcfield = -1;
7410   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7411     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7412     const PetscInt         *idxs;
7413     ISLocalToGlobalMapping tmap;
7414 
7415     /* create map between primal indices (in local representative ordering) and local primal numbering */
7416     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7417     /* allocate space for temporary storage */
7418     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7419     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7420     /* allocate for IS array */
7421     nisdofs = pcbddc->n_ISForDofsLocal;
7422     if (pcbddc->nedclocal) {
7423       if (pcbddc->nedfield > -1) {
7424         nedcfield = pcbddc->nedfield;
7425       } else {
7426         nedcfield = 0;
7427         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7428         nisdofs = 1;
7429       }
7430     }
7431     nisneu = !!pcbddc->NeumannBoundariesLocal;
7432     nisvert = 0; /* nisvert is not used */
7433     nis = nisdofs + nisneu + nisvert;
7434     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7435     /* dofs splitting */
7436     for (i=0;i<nisdofs;i++) {
7437       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7438       if (nedcfield != i) {
7439         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7440         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7441         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7442         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7443       } else {
7444         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7445         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7446         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7447         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7448         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7449       }
7450       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7451       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7452       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7453     }
7454     /* neumann boundaries */
7455     if (pcbddc->NeumannBoundariesLocal) {
7456       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7457       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7458       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7459       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7460       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7461       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7462       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7463       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7464     }
7465     /* free memory */
7466     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7467     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7468     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7469   } else {
7470     nis = 0;
7471     nisdofs = 0;
7472     nisneu = 0;
7473     nisvert = 0;
7474     isarray = NULL;
7475   }
7476   /* destroy no longer needed map */
7477   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7478 
7479   /* subassemble */
7480   if (multilevel_allowed) {
7481     Vec       vp[1];
7482     PetscInt  nvecs = 0;
7483     PetscBool reuse,reuser;
7484 
7485     if (coarse_mat) reuse = PETSC_TRUE;
7486     else reuse = PETSC_FALSE;
7487     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7488     vp[0] = NULL;
7489     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7490       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7491       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7492       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7493       nvecs = 1;
7494 
7495       if (pcbddc->divudotp) {
7496         Mat      B,loc_divudotp;
7497         Vec      v,p;
7498         IS       dummy;
7499         PetscInt np;
7500 
7501         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7502         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7503         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7504         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7505         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7506         ierr = VecSet(p,1.);CHKERRQ(ierr);
7507         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7508         ierr = VecDestroy(&p);CHKERRQ(ierr);
7509         ierr = MatDestroy(&B);CHKERRQ(ierr);
7510         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7511         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7512         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7513         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7514         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7515         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7516         ierr = VecDestroy(&v);CHKERRQ(ierr);
7517       }
7518     }
7519     if (reuser) {
7520       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7521     } else {
7522       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7523     }
7524     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7525       PetscScalar *arraym,*arrayv;
7526       PetscInt    nl;
7527       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7528       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7529       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7530       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7531       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7532       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7533       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7534       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7535     } else {
7536       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7537     }
7538   } else {
7539     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7540   }
7541   if (coarse_mat_is || coarse_mat) {
7542     PetscMPIInt size;
7543     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7544     if (!multilevel_allowed) {
7545       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7546     } else {
7547       Mat A;
7548 
7549       /* if this matrix is present, it means we are not reusing the coarse matrix */
7550       if (coarse_mat_is) {
7551         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7552         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7553         coarse_mat = coarse_mat_is;
7554       }
7555       /* be sure we don't have MatSeqDENSE as local mat */
7556       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7557       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7558     }
7559   }
7560   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7561   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7562 
7563   /* create local to global scatters for coarse problem */
7564   if (compute_vecs) {
7565     PetscInt lrows;
7566     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7567     if (coarse_mat) {
7568       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7569     } else {
7570       lrows = 0;
7571     }
7572     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7573     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7574     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7575     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7576     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7577   }
7578   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7579 
7580   /* set defaults for coarse KSP and PC */
7581   if (multilevel_allowed) {
7582     coarse_ksp_type = KSPRICHARDSON;
7583     coarse_pc_type = PCBDDC;
7584   } else {
7585     coarse_ksp_type = KSPPREONLY;
7586     coarse_pc_type = PCREDUNDANT;
7587   }
7588 
7589   /* print some info if requested */
7590   if (pcbddc->dbg_flag) {
7591     if (!multilevel_allowed) {
7592       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7593       if (multilevel_requested) {
7594         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);
7595       } else if (pcbddc->max_levels) {
7596         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7597       }
7598       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7599     }
7600   }
7601 
7602   /* communicate coarse discrete gradient */
7603   coarseG = NULL;
7604   if (pcbddc->nedcG && multilevel_allowed) {
7605     MPI_Comm ccomm;
7606     if (coarse_mat) {
7607       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7608     } else {
7609       ccomm = MPI_COMM_NULL;
7610     }
7611     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7612   }
7613 
7614   /* create the coarse KSP object only once with defaults */
7615   if (coarse_mat) {
7616     PetscViewer dbg_viewer = NULL;
7617     if (pcbddc->dbg_flag) {
7618       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7619       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7620     }
7621     if (!pcbddc->coarse_ksp) {
7622       char prefix[256],str_level[16];
7623       size_t len;
7624 
7625       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7626       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7627       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7628       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7629       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7630       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7631       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7632       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7633       /* TODO is this logic correct? should check for coarse_mat type */
7634       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7635       /* prefix */
7636       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7637       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7638       if (!pcbddc->current_level) {
7639         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7640         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7641       } else {
7642         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7643         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7644         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7645         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7646         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7647         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7648       }
7649       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7650       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7651       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7652       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7653       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7654       /* allow user customization */
7655       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7656     }
7657     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7658     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7659     if (nisdofs) {
7660       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7661       for (i=0;i<nisdofs;i++) {
7662         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7663       }
7664     }
7665     if (nisneu) {
7666       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7667       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7668     }
7669     if (nisvert) {
7670       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7671       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7672     }
7673     if (coarseG) {
7674       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7675     }
7676 
7677     /* get some info after set from options */
7678     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7679     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7680     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7681     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7682       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7683       isbddc = PETSC_FALSE;
7684     }
7685     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7686     if (isredundant) {
7687       KSP inner_ksp;
7688       PC  inner_pc;
7689       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7690       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7691       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7692     }
7693 
7694     /* parameters which miss an API */
7695     if (isbddc) {
7696       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7697       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7698       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7699       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7700       if (pcbddc_coarse->benign_saddle_point) {
7701         Mat                    coarsedivudotp_is;
7702         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7703         IS                     row,col;
7704         const PetscInt         *gidxs;
7705         PetscInt               n,st,M,N;
7706 
7707         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7708         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7709         st = st-n;
7710         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7711         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7712         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7713         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7714         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7715         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7716         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7717         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7718         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7719         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7720         ierr = ISDestroy(&row);CHKERRQ(ierr);
7721         ierr = ISDestroy(&col);CHKERRQ(ierr);
7722         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7723         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7724         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7725         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7726         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7727         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7728         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7729         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7730         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7731         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7732         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7733         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7734       }
7735     }
7736 
7737     /* propagate symmetry info of coarse matrix */
7738     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7739     if (pc->pmat->symmetric_set) {
7740       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7741     }
7742     if (pc->pmat->hermitian_set) {
7743       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7744     }
7745     if (pc->pmat->spd_set) {
7746       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7747     }
7748     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7749       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7750     }
7751     /* set operators */
7752     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7753     if (pcbddc->dbg_flag) {
7754       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7755     }
7756   }
7757   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7758   ierr = PetscFree(isarray);CHKERRQ(ierr);
7759 #if 0
7760   {
7761     PetscViewer viewer;
7762     char filename[256];
7763     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7764     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7765     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7766     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7767     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7768     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7769   }
7770 #endif
7771 
7772   if (pcbddc->coarse_ksp) {
7773     Vec crhs,csol;
7774 
7775     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7776     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7777     if (!csol) {
7778       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7779     }
7780     if (!crhs) {
7781       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7782     }
7783   }
7784   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7785 
7786   /* compute null space for coarse solver if the benign trick has been requested */
7787   if (pcbddc->benign_null) {
7788 
7789     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7790     for (i=0;i<pcbddc->benign_n;i++) {
7791       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7792     }
7793     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7794     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7795     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7796     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7797     if (coarse_mat) {
7798       Vec         nullv;
7799       PetscScalar *array,*array2;
7800       PetscInt    nl;
7801 
7802       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7803       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7804       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7805       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7806       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7807       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7808       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7809       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7810       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7811       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7812     }
7813   }
7814 
7815   if (pcbddc->coarse_ksp) {
7816     PetscBool ispreonly;
7817 
7818     if (CoarseNullSpace) {
7819       PetscBool isnull;
7820       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7821       if (isnull) {
7822         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7823       }
7824       /* TODO: add local nullspaces (if any) */
7825     }
7826     /* setup coarse ksp */
7827     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7828     /* Check coarse problem if in debug mode or if solving with an iterative method */
7829     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7830     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7831       KSP       check_ksp;
7832       KSPType   check_ksp_type;
7833       PC        check_pc;
7834       Vec       check_vec,coarse_vec;
7835       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7836       PetscInt  its;
7837       PetscBool compute_eigs;
7838       PetscReal *eigs_r,*eigs_c;
7839       PetscInt  neigs;
7840       const char *prefix;
7841 
7842       /* Create ksp object suitable for estimation of extreme eigenvalues */
7843       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7844       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7845       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7846       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7847       /* prevent from setup unneeded object */
7848       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7849       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7850       if (ispreonly) {
7851         check_ksp_type = KSPPREONLY;
7852         compute_eigs = PETSC_FALSE;
7853       } else {
7854         check_ksp_type = KSPGMRES;
7855         compute_eigs = PETSC_TRUE;
7856       }
7857       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7858       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7859       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7860       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7861       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7862       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7863       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7864       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7865       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7866       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7867       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7868       /* create random vec */
7869       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7870       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7871       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7872       /* solve coarse problem */
7873       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7874       /* set eigenvalue estimation if preonly has not been requested */
7875       if (compute_eigs) {
7876         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7877         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7878         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7879         if (neigs) {
7880           lambda_max = eigs_r[neigs-1];
7881           lambda_min = eigs_r[0];
7882           if (pcbddc->use_coarse_estimates) {
7883             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7884               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7885               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7886             }
7887           }
7888         }
7889       }
7890 
7891       /* check coarse problem residual error */
7892       if (pcbddc->dbg_flag) {
7893         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7894         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7895         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7896         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7897         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7898         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7899         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7900         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7901         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7902         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7903         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7904         if (CoarseNullSpace) {
7905           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7906         }
7907         if (compute_eigs) {
7908           PetscReal          lambda_max_s,lambda_min_s;
7909           KSPConvergedReason reason;
7910           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7911           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7912           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7913           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7914           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);
7915           for (i=0;i<neigs;i++) {
7916             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7917           }
7918         }
7919         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7920         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7921       }
7922       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7923       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7924       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7925       if (compute_eigs) {
7926         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7927         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7928       }
7929     }
7930   }
7931   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7932   /* print additional info */
7933   if (pcbddc->dbg_flag) {
7934     /* waits until all processes reaches this point */
7935     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7936     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7937     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7938   }
7939 
7940   /* free memory */
7941   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7942   PetscFunctionReturn(0);
7943 }
7944 
7945 #undef __FUNCT__
7946 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7947 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7948 {
7949   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7950   PC_IS*         pcis = (PC_IS*)pc->data;
7951   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7952   IS             subset,subset_mult,subset_n;
7953   PetscInt       local_size,coarse_size=0;
7954   PetscInt       *local_primal_indices=NULL;
7955   const PetscInt *t_local_primal_indices;
7956   PetscErrorCode ierr;
7957 
7958   PetscFunctionBegin;
7959   /* Compute global number of coarse dofs */
7960   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7961   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7962   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7963   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7964   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7965   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7966   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7967   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7968   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7969   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);
7970   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7971   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7972   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7973   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7974   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7975 
7976   /* check numbering */
7977   if (pcbddc->dbg_flag) {
7978     PetscScalar coarsesum,*array,*array2;
7979     PetscInt    i;
7980     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7981 
7982     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7983     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7984     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7985     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7986     /* counter */
7987     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7988     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7989     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7990     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7991     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7992     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7993     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7994     for (i=0;i<pcbddc->local_primal_size;i++) {
7995       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7996     }
7997     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7998     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
7999     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8000     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8001     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8002     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8003     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8004     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8005     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8006     for (i=0;i<pcis->n;i++) {
8007       if (array[i] != 0.0 && array[i] != array2[i]) {
8008         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8009         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8010         set_error = PETSC_TRUE;
8011         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8012         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);
8013       }
8014     }
8015     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8016     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8017     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8018     for (i=0;i<pcis->n;i++) {
8019       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8020     }
8021     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8022     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8023     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8024     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8025     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8026     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8027     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8028       PetscInt *gidxs;
8029 
8030       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8031       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8032       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8033       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8034       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8035       for (i=0;i<pcbddc->local_primal_size;i++) {
8036         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);
8037       }
8038       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8039       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8040     }
8041     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8042     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8043     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8044   }
8045   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8046   /* get back data */
8047   *coarse_size_n = coarse_size;
8048   *local_primal_indices_n = local_primal_indices;
8049   PetscFunctionReturn(0);
8050 }
8051 
8052 #undef __FUNCT__
8053 #define __FUNCT__ "PCBDDCGlobalToLocal"
8054 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8055 {
8056   IS             localis_t;
8057   PetscInt       i,lsize,*idxs,n;
8058   PetscScalar    *vals;
8059   PetscErrorCode ierr;
8060 
8061   PetscFunctionBegin;
8062   /* get indices in local ordering exploiting local to global map */
8063   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8064   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8065   for (i=0;i<lsize;i++) vals[i] = 1.0;
8066   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8067   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8068   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8069   if (idxs) { /* multilevel guard */
8070     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8071   }
8072   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8073   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8074   ierr = PetscFree(vals);CHKERRQ(ierr);
8075   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8076   /* now compute set in local ordering */
8077   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8078   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8079   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8080   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8081   for (i=0,lsize=0;i<n;i++) {
8082     if (PetscRealPart(vals[i]) > 0.5) {
8083       lsize++;
8084     }
8085   }
8086   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8087   for (i=0,lsize=0;i<n;i++) {
8088     if (PetscRealPart(vals[i]) > 0.5) {
8089       idxs[lsize++] = i;
8090     }
8091   }
8092   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8093   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8094   *localis = localis_t;
8095   PetscFunctionReturn(0);
8096 }
8097 
8098 #undef __FUNCT__
8099 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8100 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8101 {
8102   PC_IS               *pcis=(PC_IS*)pc->data;
8103   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8104   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8105   Mat                 S_j;
8106   PetscInt            *used_xadj,*used_adjncy;
8107   PetscBool           free_used_adj;
8108   PetscErrorCode      ierr;
8109 
8110   PetscFunctionBegin;
8111   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8112   free_used_adj = PETSC_FALSE;
8113   if (pcbddc->sub_schurs_layers == -1) {
8114     used_xadj = NULL;
8115     used_adjncy = NULL;
8116   } else {
8117     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8118       used_xadj = pcbddc->mat_graph->xadj;
8119       used_adjncy = pcbddc->mat_graph->adjncy;
8120     } else if (pcbddc->computed_rowadj) {
8121       used_xadj = pcbddc->mat_graph->xadj;
8122       used_adjncy = pcbddc->mat_graph->adjncy;
8123     } else {
8124       PetscBool      flg_row=PETSC_FALSE;
8125       const PetscInt *xadj,*adjncy;
8126       PetscInt       nvtxs;
8127 
8128       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8129       if (flg_row) {
8130         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8131         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8132         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8133         free_used_adj = PETSC_TRUE;
8134       } else {
8135         pcbddc->sub_schurs_layers = -1;
8136         used_xadj = NULL;
8137         used_adjncy = NULL;
8138       }
8139       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8140     }
8141   }
8142 
8143   /* setup sub_schurs data */
8144   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8145   if (!sub_schurs->schur_explicit) {
8146     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8147     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8148     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);
8149   } else {
8150     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8151     PetscBool isseqaij,need_change = PETSC_FALSE;
8152     PetscInt  benign_n;
8153     Mat       change = NULL;
8154     Vec       scaling = NULL;
8155     IS        change_primal = NULL;
8156 
8157     if (!pcbddc->use_vertices && reuse_solvers) {
8158       PetscInt n_vertices;
8159 
8160       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8161       reuse_solvers = (PetscBool)!n_vertices;
8162     }
8163     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8164     if (!isseqaij) {
8165       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8166       if (matis->A == pcbddc->local_mat) {
8167         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8168         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8169       } else {
8170         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8171       }
8172     }
8173     if (!pcbddc->benign_change_explicit) {
8174       benign_n = pcbddc->benign_n;
8175     } else {
8176       benign_n = 0;
8177     }
8178     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8179        We need a global reduction to avoid possible deadlocks.
8180        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8181     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8182       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8183       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8184       need_change = (PetscBool)(!need_change);
8185     }
8186     /* If the user defines additional constraints, we import them here.
8187        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 */
8188     if (need_change) {
8189       PC_IS   *pcisf;
8190       PC_BDDC *pcbddcf;
8191       PC      pcf;
8192 
8193       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8194       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8195       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8196       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8197       /* hacks */
8198       pcisf = (PC_IS*)pcf->data;
8199       pcisf->is_B_local = pcis->is_B_local;
8200       pcisf->vec1_N = pcis->vec1_N;
8201       pcisf->BtoNmap = pcis->BtoNmap;
8202       pcisf->n = pcis->n;
8203       pcisf->n_B = pcis->n_B;
8204       pcbddcf = (PC_BDDC*)pcf->data;
8205       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8206       pcbddcf->mat_graph = pcbddc->mat_graph;
8207       pcbddcf->use_faces = PETSC_TRUE;
8208       pcbddcf->use_change_of_basis = PETSC_TRUE;
8209       pcbddcf->use_change_on_faces = PETSC_TRUE;
8210       pcbddcf->use_qr_single = PETSC_TRUE;
8211       pcbddcf->fake_change = PETSC_TRUE;
8212       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8213       /* store information on primal vertices and change of basis (in local numbering) */
8214       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8215       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8216       change = pcbddcf->ConstraintMatrix;
8217       pcbddcf->ConstraintMatrix = NULL;
8218       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8219       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8220       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8221       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8222       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8223       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8224       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8225       pcf->ops->destroy = NULL;
8226       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8227     }
8228     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8229     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);
8230     ierr = MatDestroy(&change);CHKERRQ(ierr);
8231     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8232   }
8233   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8234 
8235   /* free adjacency */
8236   if (free_used_adj) {
8237     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8238   }
8239   PetscFunctionReturn(0);
8240 }
8241 
8242 #undef __FUNCT__
8243 #define __FUNCT__ "PCBDDCInitSubSchurs"
8244 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8245 {
8246   PC_IS               *pcis=(PC_IS*)pc->data;
8247   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8248   PCBDDCGraph         graph;
8249   PetscErrorCode      ierr;
8250 
8251   PetscFunctionBegin;
8252   /* attach interface graph for determining subsets */
8253   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8254     IS       verticesIS,verticescomm;
8255     PetscInt vsize,*idxs;
8256 
8257     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8258     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8259     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8260     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8261     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8262     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8263     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8264     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8265     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8266     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8267     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8268   } else {
8269     graph = pcbddc->mat_graph;
8270   }
8271   /* print some info */
8272   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8273     IS       vertices;
8274     PetscInt nv,nedges,nfaces;
8275     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8276     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8277     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8278     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8279     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8280     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8281     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8282     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8283     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8284     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8285     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8286   }
8287 
8288   /* sub_schurs init */
8289   if (!pcbddc->sub_schurs) {
8290     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8291   }
8292   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8293 
8294   /* free graph struct */
8295   if (pcbddc->sub_schurs_rebuild) {
8296     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8297   }
8298   PetscFunctionReturn(0);
8299 }
8300 
8301 #undef __FUNCT__
8302 #define __FUNCT__ "PCBDDCCheckOperator"
8303 PetscErrorCode PCBDDCCheckOperator(PC pc)
8304 {
8305   PC_IS               *pcis=(PC_IS*)pc->data;
8306   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8307   PetscErrorCode      ierr;
8308 
8309   PetscFunctionBegin;
8310   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8311     IS             zerodiag = NULL;
8312     Mat            S_j,B0_B=NULL;
8313     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8314     PetscScalar    *p0_check,*array,*array2;
8315     PetscReal      norm;
8316     PetscInt       i;
8317 
8318     /* B0 and B0_B */
8319     if (zerodiag) {
8320       IS       dummy;
8321 
8322       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8323       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8324       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8325       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8326     }
8327     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8328     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8329     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8330     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8331     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8332     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8333     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8334     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8335     /* S_j */
8336     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8337     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8338 
8339     /* mimic vector in \widetilde{W}_\Gamma */
8340     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8341     /* continuous in primal space */
8342     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8343     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8344     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8345     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8346     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8347     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8348     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8349     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8350     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8351     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8352     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8353     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8354     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8355     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8356 
8357     /* assemble rhs for coarse problem */
8358     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8359     /* local with Schur */
8360     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8361     if (zerodiag) {
8362       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8363       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8364       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8365       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8366     }
8367     /* sum on primal nodes the local contributions */
8368     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8369     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8370     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8371     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8372     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8373     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8374     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8375     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8376     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8377     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8378     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8379     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8380     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8381     /* scale primal nodes (BDDC sums contibutions) */
8382     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8383     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8384     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8385     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8386     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8387     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8388     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8389     /* global: \widetilde{B0}_B w_\Gamma */
8390     if (zerodiag) {
8391       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8392       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8393       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8394       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8395     }
8396     /* BDDC */
8397     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8398     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8399 
8400     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8401     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8402     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8403     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8404     for (i=0;i<pcbddc->benign_n;i++) {
8405       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8406     }
8407     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8408     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8409     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8410     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8411     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8412     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8413   }
8414   PetscFunctionReturn(0);
8415 }
8416 
8417 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8418 #undef __FUNCT__
8419 #define __FUNCT__ "MatMPIAIJRestrict"
8420 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8421 {
8422   Mat            At;
8423   IS             rows;
8424   PetscInt       rst,ren;
8425   PetscErrorCode ierr;
8426   PetscLayout    rmap;
8427 
8428   PetscFunctionBegin;
8429   rst = ren = 0;
8430   if (ccomm != MPI_COMM_NULL) {
8431     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8432     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8433     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8434     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8435     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8436   }
8437   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8438   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8439   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8440 
8441   if (ccomm != MPI_COMM_NULL) {
8442     Mat_MPIAIJ *a,*b;
8443     IS         from,to;
8444     Vec        gvec;
8445     PetscInt   lsize;
8446 
8447     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8448     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8449     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8450     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8451     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8452     a    = (Mat_MPIAIJ*)At->data;
8453     b    = (Mat_MPIAIJ*)(*B)->data;
8454     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8455     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8456     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8457     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8458     b->A = a->A;
8459     b->B = a->B;
8460 
8461     b->donotstash      = a->donotstash;
8462     b->roworiented     = a->roworiented;
8463     b->rowindices      = 0;
8464     b->rowvalues       = 0;
8465     b->getrowactive    = PETSC_FALSE;
8466 
8467     (*B)->rmap         = rmap;
8468     (*B)->factortype   = A->factortype;
8469     (*B)->assembled    = PETSC_TRUE;
8470     (*B)->insertmode   = NOT_SET_VALUES;
8471     (*B)->preallocated = PETSC_TRUE;
8472 
8473     if (a->colmap) {
8474 #if defined(PETSC_USE_CTABLE)
8475       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8476 #else
8477       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8478       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8479       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8480 #endif
8481     } else b->colmap = 0;
8482     if (a->garray) {
8483       PetscInt len;
8484       len  = a->B->cmap->n;
8485       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8486       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8487       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8488     } else b->garray = 0;
8489 
8490     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8491     b->lvec = a->lvec;
8492     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8493 
8494     /* cannot use VecScatterCopy */
8495     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8496     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8497     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8498     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8499     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8500     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8501     ierr = ISDestroy(&from);CHKERRQ(ierr);
8502     ierr = ISDestroy(&to);CHKERRQ(ierr);
8503     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8504   }
8505   ierr = MatDestroy(&At);CHKERRQ(ierr);
8506   PetscFunctionReturn(0);
8507 }
8508