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