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