xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision a6e023c1ecc1f9e93407908066cb03e95d99ddc3)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <petscblaslapack.h>
5 #include <petsc/private/sfimpl.h>
6 
7 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
8 
9 /* if range is true,  it returns B s.t. span{B} = range(A)
10    if range is false, it returns B s.t. range(B) _|_ range(A) */
11 #undef __FUNCT__
12 #define __FUNCT__ "MatDenseOrthogonalRangeOrComplement"
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 #undef __FUNCT__
89 #define __FUNCT__ "PCBDDCComputeNedelecChangeEdge"
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatGetSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatGetSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatGetSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 #undef __FUNCT__
156 #define __FUNCT__ "PCBDDCNedelecSupport"
157 PetscErrorCode PCBDDCNedelecSupport(PC pc)
158 {
159   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
160   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
161   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
162   Vec                    tvec;
163   PetscSF                sfv;
164   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
165   MPI_Comm               comm;
166   IS                     lned,primals,allprimals,nedfieldlocal;
167   IS                     *eedges,*extrows,*extcols,*alleedges;
168   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
169   PetscScalar            *vals,*work;
170   PetscReal              *rwork;
171   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
172   PetscInt               ne,nv,Lv,order,n,field;
173   PetscInt               n_neigh,*neigh,*n_shared,**shared;
174   PetscInt               i,j,extmem,cum,maxsize,nee;
175   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
176   PetscInt               *sfvleaves,*sfvroots;
177   PetscInt               *corners,*cedges;
178   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
179 #if defined(PETSC_USE_DEBUG)
180   PetscInt               *emarks;
181 #endif
182   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
183   PetscErrorCode         ierr;
184 
185   PetscFunctionBegin;
186   /* If the discrete gradient is defined for a subset of dofs and global is true,
187      it assumes G is given in global ordering for all the dofs.
188      Otherwise, the ordering is global for the Nedelec field */
189   order      = pcbddc->nedorder;
190   conforming = pcbddc->conforming;
191   field      = pcbddc->nedfield;
192   global     = pcbddc->nedglobal;
193   setprimal  = PETSC_FALSE;
194   print      = PETSC_FALSE;
195   singular   = PETSC_FALSE;
196 
197   /* Command line customization */
198   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
201   ierr = PetscOptionsInt ("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
202   /* print debug info TODO: to be removed */
203   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
204   ierr = PetscOptionsEnd();CHKERRQ(ierr);
205 
206   /* Return if there are no edges in the decomposition and the problem is not singular */
207   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
208   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
209   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
210   if (!singular) {
211     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
212     lrc[0] = PETSC_FALSE;
213     for (i=0;i<n;i++) {
214       if (PetscRealPart(vals[i]) > 2.) {
215         lrc[0] = PETSC_TRUE;
216         break;
217       }
218     }
219     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
220     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
221     if (!lrc[1]) PetscFunctionReturn(0);
222   }
223 
224   /* Get Nedelec field */
225   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
226   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
227   if (pcbddc->n_ISForDofsLocal && field >= 0) {
228     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
229     nedfieldlocal = pcbddc->ISForDofsLocal[field];
230     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
231   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
232     ne            = n;
233     nedfieldlocal = NULL;
234     global        = PETSC_TRUE;
235   } else if (field == PETSC_DECIDE) {
236     PetscInt rst,ren,*idx;
237 
238     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
239     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
240     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
241     for (i=rst;i<ren;i++) {
242       PetscInt nc;
243 
244       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
246       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
247     }
248     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
249     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
250     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
251     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
252     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
253   } else {
254     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
255   }
256 
257   /* Sanity checks */
258   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
259   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
260   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
261 
262   /* Just set primal dofs and return */
263   if (setprimal) {
264     IS       enedfieldlocal;
265     PetscInt *eidxs;
266 
267     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
268     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
269     if (nedfieldlocal) {
270       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
271       for (i=0,cum=0;i<ne;i++) {
272         if (PetscRealPart(vals[idxs[i]]) > 2.) {
273           eidxs[cum++] = idxs[i];
274         }
275       }
276       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
277     } else {
278       for (i=0,cum=0;i<ne;i++) {
279         if (PetscRealPart(vals[i]) > 2.) {
280           eidxs[cum++] = i;
281         }
282       }
283     }
284     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
285     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
286     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
287     ierr = PetscFree(eidxs);CHKERRQ(ierr);
288     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
289     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
290     PetscFunctionReturn(0);
291   }
292 
293   /* Compute some l2g maps */
294   if (nedfieldlocal) {
295     IS is;
296 
297     /* need to map from the local Nedelec field to local numbering */
298     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
300     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
301     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
302     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
303     if (global) {
304       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
305       el2g = al2g;
306     } else {
307       IS gis;
308 
309       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
310       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
311       ierr = ISDestroy(&gis);CHKERRQ(ierr);
312     }
313     ierr = ISDestroy(&is);CHKERRQ(ierr);
314   } else {
315     /* restore default */
316     pcbddc->nedfield = -1;
317     /* one ref for the destruction of al2g, one for el2g */
318     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
319     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
320     el2g = al2g;
321     fl2g = NULL;
322   }
323 
324   /* Start communication to drop connections for interior edges (for cc analysis only) */
325   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
326   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
327   if (nedfieldlocal) {
328     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
330     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
331   } else {
332     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
333   }
334   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
335   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
336 
337   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
338     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
339     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
340     if (global) {
341       PetscInt rst;
342 
343       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
344       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
345         if (matis->sf_rootdata[i] < 2) {
346           matis->sf_rootdata[cum++] = i + rst;
347         }
348       }
349       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
350       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
351     } else {
352       PetscInt *tbz;
353 
354       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
355       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
356       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
357       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       for (i=0,cum=0;i<ne;i++)
359         if (matis->sf_leafdata[idxs[i]] == 1)
360           tbz[cum++] = i;
361       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
362       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
363       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
364       ierr = PetscFree(tbz);CHKERRQ(ierr);
365     }
366   } else { /* we need the entire G to infer the nullspace */
367     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
368     G    = pcbddc->discretegradient;
369   }
370 
371   /* Extract subdomain relevant rows of G */
372   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
374   ierr = MatGetSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
375   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
376   ierr = ISDestroy(&lned);CHKERRQ(ierr);
377   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
378   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
379   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
380 
381   /* SF for nodal dofs communications */
382   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
383   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
384   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
386   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
388   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
389   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
390   i    = singular ? 2 : 1;
391   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
392 
393   /* Destroy temporary G created in MATIS format and modified G */
394   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
395   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
396   ierr = MatDestroy(&G);CHKERRQ(ierr);
397 
398   if (print) {
399     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
400     ierr = MatView(lG,NULL);CHKERRQ(ierr);
401   }
402 
403   /* Save lG for values insertion in change of basis */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
405 
406   /* Analyze the edge-nodes connections (duplicate lG) */
407   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
408   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
411   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
412   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
413   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
414   /* need to import the boundary specification to ensure the
415      proper detection of coarse edges' endpoints */
416   if (pcbddc->DirichletBoundariesLocal) {
417     IS is;
418 
419     if (fl2g) {
420       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
421     } else {
422       is = pcbddc->DirichletBoundariesLocal;
423     }
424     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
425     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
426     for (i=0;i<cum;i++) {
427       if (idxs[i] >= 0) {
428         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
429         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
430       }
431     }
432     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
433     if (fl2g) {
434       ierr = ISDestroy(&is);CHKERRQ(ierr);
435     }
436   }
437   if (pcbddc->NeumannBoundariesLocal) {
438     IS is;
439 
440     if (fl2g) {
441       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
442     } else {
443       is = pcbddc->NeumannBoundariesLocal;
444     }
445     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
446     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
447     for (i=0;i<cum;i++) {
448       if (idxs[i] >= 0) {
449         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
450       }
451     }
452     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
453     if (fl2g) {
454       ierr = ISDestroy(&is);CHKERRQ(ierr);
455     }
456   }
457 
458   /* Count neighs per dof */
459   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
460   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
461   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
462   for (i=1,cum=0;i<n_neigh;i++) {
463     cum += n_shared[i];
464     for (j=0;j<n_shared[i];j++) {
465       ecount[shared[i][j]]++;
466     }
467   }
468   if (ne) {
469     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
470   }
471   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
472   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
473   for (i=1;i<n_neigh;i++) {
474     for (j=0;j<n_shared[i];j++) {
475       PetscInt k = shared[i][j];
476       eneighs[k][ecount[k]] = neigh[i];
477       ecount[k]++;
478     }
479   }
480   for (i=0;i<ne;i++) {
481     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
482   }
483   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
484   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
485   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
486   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
487   for (i=1,cum=0;i<n_neigh;i++) {
488     cum += n_shared[i];
489     for (j=0;j<n_shared[i];j++) {
490       vcount[shared[i][j]]++;
491     }
492   }
493   if (nv) {
494     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
495   }
496   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
497   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
498   for (i=1;i<n_neigh;i++) {
499     for (j=0;j<n_shared[i];j++) {
500       PetscInt k = shared[i][j];
501       vneighs[k][vcount[k]] = neigh[i];
502       vcount[k]++;
503     }
504   }
505   for (i=0;i<nv;i++) {
506     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
507   }
508   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
509 
510   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
511      for proper detection of coarse edges' endpoints */
512   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
513   for (i=0;i<ne;i++) {
514     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
515       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
516     }
517   }
518   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
519   if (!conforming) {
520     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
521     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
522   }
523   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
525   cum  = 0;
526   for (i=0;i<ne;i++) {
527     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
528     if (!PetscBTLookup(btee,i)) {
529       marks[cum++] = i;
530       continue;
531     }
532     /* set badly connected edge dofs as primal */
533     if (!conforming) {
534       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
535         marks[cum++] = i;
536         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
537         for (j=ii[i];j<ii[i+1];j++) {
538           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
539         }
540       } else {
541         /* every edge dofs should be connected trough a certain number of nodal dofs
542            to other edge dofs belonging to coarse edges
543            - at most 2 endpoints
544            - order-1 interior nodal dofs
545            - no undefined nodal dofs (nconn < order)
546         */
547         PetscInt ends = 0,ints = 0, undef = 0;
548         for (j=ii[i];j<ii[i+1];j++) {
549           PetscInt v = jj[j],k;
550           PetscInt nconn = iit[v+1]-iit[v];
551           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
552           if (nconn > order) ends++;
553           else if (nconn == order) ints++;
554           else undef++;
555         }
556         if (undef || ends > 2 || ints != order -1) {
557           marks[cum++] = i;
558           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
559           for (j=ii[i];j<ii[i+1];j++) {
560             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
561           }
562         }
563       }
564     }
565     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
566     if (!order && ii[i+1] != ii[i]) {
567       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
568       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
569     }
570   }
571   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
572   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
573   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
574   if (!conforming) {
575     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
576     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
577   }
578   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
579 
580   /* identify splitpoints and corner candidates */
581   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
582   if (print) {
583     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
584     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
585     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
586     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
587   }
588   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
589   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
590   for (i=0;i<nv;i++) {
591     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
592     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
593     if (!order) { /* variable order */
594       PetscReal vorder = 0.;
595 
596       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
597       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
598       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
599       ord  = 1;
600     }
601 #if defined(PETSC_USE_DEBUG)
602     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
603 #endif
604     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
605       if (PetscBTLookup(btbd,jj[j])) {
606         bdir = PETSC_TRUE;
607         break;
608       }
609       if (vc != ecount[jj[j]]) {
610         sneighs = PETSC_FALSE;
611       } else {
612         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
613         for (k=0;k<vc;k++) {
614           if (vn[k] != en[k]) {
615             sneighs = PETSC_FALSE;
616             break;
617           }
618         }
619       }
620     }
621     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
622       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
623       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624     } else if (test == ord) {
625       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
626         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
627         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
628       } else {
629         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
630         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
631       }
632     }
633   }
634   ierr = PetscFree(ecount);CHKERRQ(ierr);
635   ierr = PetscFree(vcount);CHKERRQ(ierr);
636   if (ne) {
637     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
638   }
639   if (nv) {
640     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
641   }
642   ierr = PetscFree(eneighs);CHKERRQ(ierr);
643   ierr = PetscFree(vneighs);CHKERRQ(ierr);
644   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
645 
646   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
647   if (order != 1) {
648     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
649     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
650     for (i=0;i<nv;i++) {
651       if (PetscBTLookup(btvcand,i)) {
652         PetscBool found = PETSC_FALSE;
653         for (j=ii[i];j<ii[i+1] && !found;j++) {
654           PetscInt k,e = jj[j];
655           if (PetscBTLookup(bte,e)) continue;
656           for (k=iit[e];k<iit[e+1];k++) {
657             PetscInt v = jjt[k];
658             if (v != i && PetscBTLookup(btvcand,v)) {
659               found = PETSC_TRUE;
660               break;
661             }
662           }
663         }
664         if (!found) {
665           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
666           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
667         } else {
668           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
669         }
670       }
671     }
672     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
673   }
674   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
675   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
676   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
677 
678   /* Get the local G^T explicitly */
679   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
680   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
681   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
682 
683   /* Mark interior nodal dofs */
684   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
685   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
686   for (i=1;i<n_neigh;i++) {
687     for (j=0;j<n_shared[i];j++) {
688       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
689     }
690   }
691   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
692 
693   /* communicate corners and splitpoints */
694   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
695   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
696   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
697   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
698 
699   if (print) {
700     IS tbz;
701 
702     cum = 0;
703     for (i=0;i<nv;i++)
704       if (sfvleaves[i])
705         vmarks[cum++] = i;
706 
707     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
708     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
709     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
710     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
711   }
712 
713   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
714   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
715   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
716   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
717 
718   /* Zero rows of lGt corresponding to identified corners
719      and interior nodal dofs */
720   cum = 0;
721   for (i=0;i<nv;i++) {
722     if (sfvleaves[i]) {
723       vmarks[cum++] = i;
724       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
725     }
726     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
727   }
728   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
729   if (print) {
730     IS tbz;
731 
732     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
733     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
734     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
735     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
736   }
737   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
738   ierr = PetscFree(vmarks);CHKERRQ(ierr);
739   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
740   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
741 
742   /* Recompute G */
743   ierr = MatDestroy(&lG);CHKERRQ(ierr);
744   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
745   if (print) {
746     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
747     ierr = MatView(lG,NULL);CHKERRQ(ierr);
748     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
749     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
750   }
751 
752   /* Get primal dofs (if any) */
753   cum = 0;
754   for (i=0;i<ne;i++) {
755     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
756   }
757   if (fl2g) {
758     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
759   }
760   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
761   if (print) {
762     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
763     ierr = ISView(primals,NULL);CHKERRQ(ierr);
764   }
765   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
766   /* TODO: what if the user passed in some of them ?  */
767   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
768   ierr = ISDestroy(&primals);CHKERRQ(ierr);
769 
770   /* Compute edge connectivity */
771   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
772   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
773   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
774   if (fl2g) {
775     PetscBT   btf;
776     PetscInt  *iia,*jja,*iiu,*jju;
777     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
778 
779     /* create CSR for all local dofs */
780     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
781     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
782       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
783       iiu = pcbddc->mat_graph->xadj;
784       jju = pcbddc->mat_graph->adjncy;
785     } else if (pcbddc->use_local_adj) {
786       rest = PETSC_TRUE;
787       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
788     } else {
789       free   = PETSC_TRUE;
790       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
791       iiu[0] = 0;
792       for (i=0;i<n;i++) {
793         iiu[i+1] = i+1;
794         jju[i]   = -1;
795       }
796     }
797 
798     /* import sizes of CSR */
799     iia[0] = 0;
800     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
801 
802     /* overwrite entries corresponding to the Nedelec field */
803     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
804     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
805     for (i=0;i<ne;i++) {
806       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
807       iia[idxs[i]+1] = ii[i+1]-ii[i];
808     }
809 
810     /* iia in CSR */
811     for (i=0;i<n;i++) iia[i+1] += iia[i];
812 
813     /* jja in CSR */
814     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
815     for (i=0;i<n;i++)
816       if (!PetscBTLookup(btf,i))
817         for (j=0;j<iiu[i+1]-iiu[i];j++)
818           jja[iia[i]+j] = jju[iiu[i]+j];
819 
820     /* map edge dofs connectivity */
821     if (jj) {
822       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
823       for (i=0;i<ne;i++) {
824         PetscInt e = idxs[i];
825         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
826       }
827     }
828     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
829     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
830     if (rest) {
831       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
832     }
833     if (free) {
834       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
835     }
836     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
837   } else {
838     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
839   }
840 
841   /* Analyze interface for edge dofs */
842   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
843   pcbddc->mat_graph->twodim = PETSC_FALSE;
844 
845   /* Get coarse edges in the edge space */
846   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
847   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
848 
849   if (fl2g) {
850     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
851     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
852     for (i=0;i<nee;i++) {
853       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
854     }
855   } else {
856     eedges  = alleedges;
857     primals = allprimals;
858   }
859 
860   /* Mark fine edge dofs with their coarse edge id */
861   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
862   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
863   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
864   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
865   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
866   if (print) {
867     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
868     ierr = ISView(primals,NULL);CHKERRQ(ierr);
869   }
870 
871   maxsize = 0;
872   for (i=0;i<nee;i++) {
873     PetscInt size,mark = i+1;
874 
875     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
876     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     for (j=0;j<size;j++) marks[idxs[j]] = mark;
878     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
879     maxsize = PetscMax(maxsize,size);
880   }
881 
882   /* Find coarse edge endpoints */
883   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
884   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
885   for (i=0;i<nee;i++) {
886     PetscInt mark = i+1,size;
887 
888     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
889     if (!size && nedfieldlocal) continue;
890     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
891     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
892     if (print) {
893       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
894       ISView(eedges[i],NULL);
895     }
896     for (j=0;j<size;j++) {
897       PetscInt k, ee = idxs[j];
898       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
899       for (k=ii[ee];k<ii[ee+1];k++) {
900         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
901         if (PetscBTLookup(btv,jj[k])) {
902           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
903         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
904           PetscInt  k2;
905           PetscBool corner = PETSC_FALSE;
906           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
907             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
908             /* it's a corner if either is connected with an edge dof belonging to a different cc or
909                if the edge dof lie on the natural part of the boundary */
910             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
911               corner = PETSC_TRUE;
912               break;
913             }
914           }
915           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
916             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
917             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
918           } else {
919             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
920           }
921         }
922       }
923     }
924     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
925   }
926   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
927   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
928   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
929 
930   /* Reset marked primal dofs */
931   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
932   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
933   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
934   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
935 
936   /* Now use the initial lG */
937   ierr = MatDestroy(&lG);CHKERRQ(ierr);
938   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
939   lG   = lGinit;
940   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
941 
942   /* Compute extended cols indices */
943   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
944   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
945   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
946   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
947   i   *= maxsize;
948   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
949   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
950   eerr = PETSC_FALSE;
951   for (i=0;i<nee;i++) {
952     PetscInt size,found = 0;
953 
954     cum  = 0;
955     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
956     if (!size && nedfieldlocal) continue;
957     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
958     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
959     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
960     for (j=0;j<size;j++) {
961       PetscInt k,ee = idxs[j];
962       for (k=ii[ee];k<ii[ee+1];k++) {
963         PetscInt vv = jj[k];
964         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
965         else if (!PetscBTLookupSet(btvc,vv)) found++;
966       }
967     }
968     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
969     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
970     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
971     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
972     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
973     /* it may happen that endpoints are not defined at this point
974        if it is the case, mark this edge for a second pass */
975     if (cum != size -1 || found != 2) {
976       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
977       if (print) {
978         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
979         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
980         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
981         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
982       }
983       eerr = PETSC_TRUE;
984     }
985   }
986   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
987   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
988   if (done) {
989     PetscInt *newprimals;
990 
991     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
992     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
993     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
995     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
996     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
997     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
998     for (i=0;i<nee;i++) {
999       PetscBool has_candidates = PETSC_FALSE;
1000       if (PetscBTLookup(bter,i)) {
1001         PetscInt size,mark = i+1;
1002 
1003         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1004         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1005         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1006         for (j=0;j<size;j++) {
1007           PetscInt k,ee = idxs[j];
1008           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1009           for (k=ii[ee];k<ii[ee+1];k++) {
1010             /* set all candidates located on the edge as corners */
1011             if (PetscBTLookup(btvcand,jj[k])) {
1012               PetscInt k2,vv = jj[k];
1013               has_candidates = PETSC_TRUE;
1014               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1015               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1016               /* set all edge dofs connected to candidate as primals */
1017               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1018                 if (marks[jjt[k2]] == mark) {
1019                   PetscInt k3,ee2 = jjt[k2];
1020                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1021                   newprimals[cum++] = ee2;
1022                   /* finally set the new corners */
1023                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1024                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1025                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1026                   }
1027                 }
1028               }
1029             } else {
1030               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1031             }
1032           }
1033         }
1034         if (!has_candidates) { /* circular edge */
1035           PetscInt k, ee = idxs[0],*tmarks;
1036 
1037           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1038           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1039           for (k=ii[ee];k<ii[ee+1];k++) {
1040             PetscInt k2;
1041             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1042             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1043             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1044           }
1045           for (j=0;j<size;j++) {
1046             if (tmarks[idxs[j]] > 1) {
1047               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1048               newprimals[cum++] = idxs[j];
1049             }
1050           }
1051           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1052         }
1053         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       }
1055       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1056     }
1057     ierr = PetscFree(extcols);CHKERRQ(ierr);
1058     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1059     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1060     if (fl2g) {
1061       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1062       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1063       for (i=0;i<nee;i++) {
1064         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1065       }
1066       ierr = PetscFree(eedges);CHKERRQ(ierr);
1067     }
1068     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1069     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1070     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1071     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1072     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1073     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1074     pcbddc->mat_graph->twodim = PETSC_FALSE;
1075     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1076     if (fl2g) {
1077       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1078       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1079       for (i=0;i<nee;i++) {
1080         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1081       }
1082     } else {
1083       eedges  = alleedges;
1084       primals = allprimals;
1085     }
1086     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1087 
1088     /* Mark again */
1089     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1090     for (i=0;i<nee;i++) {
1091       PetscInt size,mark = i+1;
1092 
1093       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1094       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1096       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1097     }
1098     if (print) {
1099       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1100       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1101     }
1102 
1103     /* Recompute extended cols */
1104     eerr = PETSC_FALSE;
1105     for (i=0;i<nee;i++) {
1106       PetscInt size;
1107 
1108       cum  = 0;
1109       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1110       if (!size && nedfieldlocal) continue;
1111       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1112       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1113       for (j=0;j<size;j++) {
1114         PetscInt k,ee = idxs[j];
1115         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1116       }
1117       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1118       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1119       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1120       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1121       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1122       if (cum != size -1) {
1123         if (print) {
1124           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1126           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1127           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1128         }
1129         eerr = PETSC_TRUE;
1130       }
1131     }
1132   }
1133   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1135   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1136   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1137   /* an error should not occur at this point */
1138   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1139 
1140   /* Check the number of endpoints */
1141   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1142   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1143   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1144   for (i=0;i<nee;i++) {
1145     PetscInt size, found = 0, gc[2];
1146 
1147     /* init with defaults */
1148     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1149     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1150     if (!size && nedfieldlocal) continue;
1151     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1152     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1153     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1154     for (j=0;j<size;j++) {
1155       PetscInt k,ee = idxs[j];
1156       for (k=ii[ee];k<ii[ee+1];k++) {
1157         PetscInt vv = jj[k];
1158         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1159           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1160           corners[i*2+found++] = vv;
1161         }
1162       }
1163     }
1164     if (found != 2) {
1165       PetscInt e;
1166       if (fl2g) {
1167         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1168       } else {
1169         e = idxs[0];
1170       }
1171       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1172     }
1173 
1174     /* get primal dof index on this coarse edge */
1175     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1176     if (gc[0] > gc[1]) {
1177       PetscInt swap  = corners[2*i];
1178       corners[2*i]   = corners[2*i+1];
1179       corners[2*i+1] = swap;
1180     }
1181     cedges[i] = idxs[size-1];
1182     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1183     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1184   }
1185   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1187 
1188 #if defined(PETSC_USE_DEBUG)
1189   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1190      not interfere with neighbouring coarse edges */
1191   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1192   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1193   for (i=0;i<nv;i++) {
1194     PetscInt emax = 0,eemax = 0;
1195 
1196     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1197     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1198     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1199     for (j=1;j<nee+1;j++) {
1200       if (emax < emarks[j]) {
1201         emax = emarks[j];
1202         eemax = j;
1203       }
1204     }
1205     /* not relevant for edges */
1206     if (!eemax) continue;
1207 
1208     for (j=ii[i];j<ii[i+1];j++) {
1209       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1210         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1211       }
1212     }
1213   }
1214   ierr = PetscFree(emarks);CHKERRQ(ierr);
1215   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216 #endif
1217 
1218   /* Compute extended rows indices for edge blocks of the change of basis */
1219   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1220   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1221   extmem *= maxsize;
1222   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1223   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1224   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1225   for (i=0;i<nv;i++) {
1226     PetscInt mark = 0,size,start;
1227 
1228     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1229     for (j=ii[i];j<ii[i+1];j++)
1230       if (marks[jj[j]] && !mark)
1231         mark = marks[jj[j]];
1232 
1233     /* not relevant */
1234     if (!mark) continue;
1235 
1236     /* import extended row */
1237     mark--;
1238     start = mark*extmem+extrowcum[mark];
1239     size = ii[i+1]-ii[i];
1240     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1241     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1242     extrowcum[mark] += size;
1243   }
1244   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1245   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1246   ierr = PetscFree(marks);CHKERRQ(ierr);
1247 
1248   /* Compress extrows */
1249   cum  = 0;
1250   for (i=0;i<nee;i++) {
1251     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1252     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1253     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1254     cum  = PetscMax(cum,size);
1255   }
1256   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1257   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1258   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1259 
1260   /* Workspace for lapack inner calls and VecSetValues */
1261   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1262 
1263   /* Create change of basis matrix (preallocation can be improved) */
1264   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1265   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1266                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1267   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1268   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1269   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1270   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1271   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1272   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1273   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1274 
1275   /* Defaults to identity */
1276   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1277   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1278   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1279   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1280 
1281   /* Create discrete gradient for the coarser level if needed */
1282   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1283   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1284   if (pcbddc->current_level < pcbddc->max_levels) {
1285     ISLocalToGlobalMapping cel2g,cvl2g;
1286     IS                     wis,gwis;
1287     PetscInt               cnv,cne;
1288 
1289     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1290     if (fl2g) {
1291       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1292     } else {
1293       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1294       pcbddc->nedclocal = wis;
1295     }
1296     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1298     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1299     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1300     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1302 
1303     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1304     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1306     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1307     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1308     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1309     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1310 
1311     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1312     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1313     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1314     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1315     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1316     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1317     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1318     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1319   }
1320   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1321 
1322 #if defined(PRINT_GDET)
1323   inc = 0;
1324   lev = pcbddc->current_level;
1325 #endif
1326 
1327   /* Insert values in the change of basis matrix */
1328   for (i=0;i<nee;i++) {
1329     Mat         Gins = NULL, GKins = NULL;
1330     IS          cornersis = NULL;
1331     PetscScalar cvals[2];
1332 
1333     if (pcbddc->nedcG) {
1334       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1335     }
1336     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1337     if (Gins && GKins) {
1338       PetscScalar    *data;
1339       const PetscInt *rows,*cols;
1340       PetscInt       nrh,nch,nrc,ncc;
1341 
1342       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1343       /* H1 */
1344       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1345       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1346       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1348       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1349       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1350       /* complement */
1351       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1352       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1353       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1354       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1355       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1356       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1357       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1358 
1359       /* coarse discrete gradient */
1360       if (pcbddc->nedcG) {
1361         PetscInt cols[2];
1362 
1363         cols[0] = 2*i;
1364         cols[1] = 2*i+1;
1365         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1366       }
1367       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1368     }
1369     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1370     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1371     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1372     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1373     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1376 
1377   /* Start assembling */
1378   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   if (pcbddc->nedcG) {
1380     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1381   }
1382 
1383   /* Free */
1384   if (fl2g) {
1385     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1386     for (i=0;i<nee;i++) {
1387       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1388     }
1389     ierr = PetscFree(eedges);CHKERRQ(ierr);
1390   }
1391 
1392   /* hack mat_graph with primal dofs on the coarse edges */
1393   {
1394     PCBDDCGraph graph   = pcbddc->mat_graph;
1395     PetscInt    *oqueue = graph->queue;
1396     PetscInt    *ocptr  = graph->cptr;
1397     PetscInt    ncc,*idxs;
1398 
1399     /* find first primal edge */
1400     if (pcbddc->nedclocal) {
1401       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1402     } else {
1403       if (fl2g) {
1404         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1405       }
1406       idxs = cedges;
1407     }
1408     cum = 0;
1409     while (cum < nee && cedges[cum] < 0) cum++;
1410 
1411     /* adapt connected components */
1412     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1413     graph->cptr[0] = 0;
1414     for (i=0,ncc=0;i<graph->ncc;i++) {
1415       PetscInt lc = ocptr[i+1]-ocptr[i];
1416       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1417         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1418         graph->queue[graph->cptr[ncc]] = cedges[cum];
1419         ncc++;
1420         lc--;
1421         cum++;
1422         while (cum < nee && cedges[cum] < 0) cum++;
1423       }
1424       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1425       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1426       ncc++;
1427     }
1428     graph->ncc = ncc;
1429     if (pcbddc->nedclocal) {
1430       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1431     }
1432     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1433   }
1434   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1435   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1436   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1437   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1438 
1439   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1440   ierr = PetscFree(extrow);CHKERRQ(ierr);
1441   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1442   ierr = PetscFree(corners);CHKERRQ(ierr);
1443   ierr = PetscFree(cedges);CHKERRQ(ierr);
1444   ierr = PetscFree(extrows);CHKERRQ(ierr);
1445   ierr = PetscFree(extcols);CHKERRQ(ierr);
1446   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1447 
1448   /* Complete assembling */
1449   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450   if (pcbddc->nedcG) {
1451     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1452 #if 0
1453     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1454     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1455 #endif
1456   }
1457 
1458   /* set change of basis */
1459   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1460   ierr = MatDestroy(&T);CHKERRQ(ierr);
1461 
1462   PetscFunctionReturn(0);
1463 }
1464 
1465 /* the near-null space of BDDC carries information on quadrature weights,
1466    and these can be collinear -> so cheat with MatNullSpaceCreate
1467    and create a suitable set of basis vectors first */
1468 #undef __FUNCT__
1469 #define __FUNCT__ "PCBDDCNullSpaceCreate"
1470 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1471 {
1472   PetscErrorCode ierr;
1473   PetscInt       i;
1474 
1475   PetscFunctionBegin;
1476   for (i=0;i<nvecs;i++) {
1477     PetscInt first,last;
1478 
1479     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1480     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1481     if (i>=first && i < last) {
1482       PetscScalar *data;
1483       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1484       if (!has_const) {
1485         data[i-first] = 1.;
1486       } else {
1487         data[2*i-first] = 1./PetscSqrtReal(2.);
1488         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1489       }
1490       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1491     }
1492     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1493   }
1494   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1495   for (i=0;i<nvecs;i++) { /* reset vectors */
1496     PetscInt first,last;
1497     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1498     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1499     if (i>=first && i < last) {
1500       PetscScalar *data;
1501       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1502       if (!has_const) {
1503         data[i-first] = 0.;
1504       } else {
1505         data[2*i-first] = 0.;
1506         data[2*i-first+1] = 0.;
1507       }
1508       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1509     }
1510     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1511     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1512   }
1513   PetscFunctionReturn(0);
1514 }
1515 
1516 #undef __FUNCT__
1517 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
1518 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1519 {
1520   Mat                    loc_divudotp;
1521   Vec                    p,v,vins,quad_vec,*quad_vecs;
1522   ISLocalToGlobalMapping map;
1523   IS                     *faces,*edges;
1524   PetscScalar            *vals;
1525   const PetscScalar      *array;
1526   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1527   PetscMPIInt            rank;
1528   PetscErrorCode         ierr;
1529 
1530   PetscFunctionBegin;
1531   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1532   if (graph->twodim) {
1533     lmaxneighs = 2;
1534   } else {
1535     lmaxneighs = 1;
1536     for (i=0;i<ne;i++) {
1537       const PetscInt *idxs;
1538       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1539       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1540       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1541     }
1542     lmaxneighs++; /* graph count does not include self */
1543   }
1544   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1545   maxsize = 0;
1546   for (i=0;i<ne;i++) {
1547     PetscInt nn;
1548     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1549     maxsize = PetscMax(maxsize,nn);
1550   }
1551   for (i=0;i<nf;i++) {
1552     PetscInt nn;
1553     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1554     maxsize = PetscMax(maxsize,nn);
1555   }
1556   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1557   /* create vectors to hold quadrature weights */
1558   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1559   if (!transpose) {
1560     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1561   } else {
1562     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1563   }
1564   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1565   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1566   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1567   for (i=0;i<maxneighs;i++) {
1568     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1569     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1570   }
1571 
1572   /* compute local quad vec */
1573   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1574   if (!transpose) {
1575     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1576   } else {
1577     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1578   }
1579   ierr = VecSet(p,1.);CHKERRQ(ierr);
1580   if (!transpose) {
1581     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1582   } else {
1583     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1584   }
1585   if (vl2l) {
1586     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 #undef __FUNCT__
1641 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
1642 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1643 {
1644   PetscErrorCode ierr;
1645   Vec            local,global;
1646   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1647   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1648 
1649   PetscFunctionBegin;
1650   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1651   /* need to convert from global to local topology information and remove references to information in global ordering */
1652   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1653   if (pcbddc->user_provided_isfordofs) {
1654     if (pcbddc->n_ISForDofs) {
1655       PetscInt i;
1656       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1657       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1658         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1659         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1660       }
1661       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1662       pcbddc->n_ISForDofs = 0;
1663       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1664     }
1665   } else {
1666     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
1667       PetscInt i, n = matis->A->rmap->n;
1668       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1669       if (i > 1) {
1670         pcbddc->n_ISForDofsLocal = i;
1671         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1672         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1673           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1674         }
1675       }
1676     } else {
1677       PetscInt i;
1678       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1679         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680       }
1681     }
1682   }
1683 
1684   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1685     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1686   } else if (pcbddc->DirichletBoundariesLocal) {
1687     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1688   }
1689   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1690     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1691   } else if (pcbddc->NeumannBoundariesLocal) {
1692     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1693   }
1694   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1695     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1696   }
1697   ierr = VecDestroy(&global);CHKERRQ(ierr);
1698   ierr = VecDestroy(&local);CHKERRQ(ierr);
1699 
1700   PetscFunctionReturn(0);
1701 }
1702 
1703 #undef __FUNCT__
1704 #define __FUNCT__ "PCBDDCConsistencyCheckIS"
1705 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1706 {
1707   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1708   PetscErrorCode  ierr;
1709   IS              nis;
1710   const PetscInt  *idxs;
1711   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1712   PetscBool       *ld;
1713 
1714   PetscFunctionBegin;
1715   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1716   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1717   if (mop == MPI_LAND) {
1718     /* init rootdata with true */
1719     ld   = (PetscBool*) matis->sf_rootdata;
1720     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1721   } else {
1722     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1723   }
1724   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1725   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1726   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1727   ld   = (PetscBool*) matis->sf_leafdata;
1728   for (i=0;i<nd;i++)
1729     if (-1 < idxs[i] && idxs[i] < n)
1730       ld[idxs[i]] = PETSC_TRUE;
1731   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1732   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1733   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1734   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1735   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1736   if (mop == MPI_LAND) {
1737     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1738   } else {
1739     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1740   }
1741   for (i=0,nnd=0;i<n;i++)
1742     if (ld[i])
1743       nidxs[nnd++] = i;
1744   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1745   ierr = ISDestroy(is);CHKERRQ(ierr);
1746   *is  = nis;
1747   PetscFunctionReturn(0);
1748 }
1749 
1750 #undef __FUNCT__
1751 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
1752 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1753 {
1754   PC_IS             *pcis = (PC_IS*)(pc->data);
1755   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1756   PetscErrorCode    ierr;
1757 
1758   PetscFunctionBegin;
1759   if (!pcbddc->benign_have_null) {
1760     PetscFunctionReturn(0);
1761   }
1762   if (pcbddc->ChangeOfBasisMatrix) {
1763     Vec swap;
1764 
1765     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1766     swap = pcbddc->work_change;
1767     pcbddc->work_change = r;
1768     r = swap;
1769   }
1770   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1771   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1772   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1773   ierr = VecSet(z,0.);CHKERRQ(ierr);
1774   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1775   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1776   if (pcbddc->ChangeOfBasisMatrix) {
1777     pcbddc->work_change = r;
1778     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1779     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1780   }
1781   PetscFunctionReturn(0);
1782 }
1783 
1784 #undef __FUNCT__
1785 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
1786 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1787 {
1788   PCBDDCBenignMatMult_ctx ctx;
1789   PetscErrorCode          ierr;
1790   PetscBool               apply_right,apply_left,reset_x;
1791 
1792   PetscFunctionBegin;
1793   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1794   if (transpose) {
1795     apply_right = ctx->apply_left;
1796     apply_left = ctx->apply_right;
1797   } else {
1798     apply_right = ctx->apply_right;
1799     apply_left = ctx->apply_left;
1800   }
1801   reset_x = PETSC_FALSE;
1802   if (apply_right) {
1803     const PetscScalar *ax;
1804     PetscInt          nl,i;
1805 
1806     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1807     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1808     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1809     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1810     for (i=0;i<ctx->benign_n;i++) {
1811       PetscScalar    sum,val;
1812       const PetscInt *idxs;
1813       PetscInt       nz,j;
1814       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1815       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1816       sum = 0.;
1817       if (ctx->apply_p0) {
1818         val = ctx->work[idxs[nz-1]];
1819         for (j=0;j<nz-1;j++) {
1820           sum += ctx->work[idxs[j]];
1821           ctx->work[idxs[j]] += val;
1822         }
1823       } else {
1824         for (j=0;j<nz-1;j++) {
1825           sum += ctx->work[idxs[j]];
1826         }
1827       }
1828       ctx->work[idxs[nz-1]] -= sum;
1829       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1830     }
1831     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1832     reset_x = PETSC_TRUE;
1833   }
1834   if (transpose) {
1835     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1836   } else {
1837     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1838   }
1839   if (reset_x) {
1840     ierr = VecResetArray(x);CHKERRQ(ierr);
1841   }
1842   if (apply_left) {
1843     PetscScalar *ay;
1844     PetscInt    i;
1845 
1846     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1847     for (i=0;i<ctx->benign_n;i++) {
1848       PetscScalar    sum,val;
1849       const PetscInt *idxs;
1850       PetscInt       nz,j;
1851       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1852       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1853       val = -ay[idxs[nz-1]];
1854       if (ctx->apply_p0) {
1855         sum = 0.;
1856         for (j=0;j<nz-1;j++) {
1857           sum += ay[idxs[j]];
1858           ay[idxs[j]] += val;
1859         }
1860         ay[idxs[nz-1]] += sum;
1861       } else {
1862         for (j=0;j<nz-1;j++) {
1863           ay[idxs[j]] += val;
1864         }
1865         ay[idxs[nz-1]] = 0.;
1866       }
1867       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1868     }
1869     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1870   }
1871   PetscFunctionReturn(0);
1872 }
1873 
1874 #undef __FUNCT__
1875 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
1876 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1877 {
1878   PetscErrorCode ierr;
1879 
1880   PetscFunctionBegin;
1881   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1882   PetscFunctionReturn(0);
1883 }
1884 
1885 #undef __FUNCT__
1886 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
1887 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1888 {
1889   PetscErrorCode ierr;
1890 
1891   PetscFunctionBegin;
1892   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1893   PetscFunctionReturn(0);
1894 }
1895 
1896 #undef __FUNCT__
1897 #define __FUNCT__ "PCBDDCBenignShellMat"
1898 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1899 {
1900   PC_IS                   *pcis = (PC_IS*)pc->data;
1901   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1902   PCBDDCBenignMatMult_ctx ctx;
1903   PetscErrorCode          ierr;
1904 
1905   PetscFunctionBegin;
1906   if (!restore) {
1907     Mat                A_IB,A_BI;
1908     PetscScalar        *work;
1909     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1910 
1911     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1912     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1913     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1914     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1915     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1916     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1917     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1918     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1919     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1920     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1921     ctx->apply_left = PETSC_TRUE;
1922     ctx->apply_right = PETSC_FALSE;
1923     ctx->apply_p0 = PETSC_FALSE;
1924     ctx->benign_n = pcbddc->benign_n;
1925     if (reuse) {
1926       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1927       ctx->free = PETSC_FALSE;
1928     } else { /* TODO: could be optimized for successive solves */
1929       ISLocalToGlobalMapping N_to_D;
1930       PetscInt               i;
1931 
1932       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1933       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1934       for (i=0;i<pcbddc->benign_n;i++) {
1935         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1936       }
1937       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1938       ctx->free = PETSC_TRUE;
1939     }
1940     ctx->A = pcis->A_IB;
1941     ctx->work = work;
1942     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1943     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1944     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1945     pcis->A_IB = A_IB;
1946 
1947     /* A_BI as A_IB^T */
1948     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1949     pcbddc->benign_original_mat = pcis->A_BI;
1950     pcis->A_BI = A_BI;
1951   } else {
1952     if (!pcbddc->benign_original_mat) {
1953       PetscFunctionReturn(0);
1954     }
1955     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1956     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1957     pcis->A_IB = ctx->A;
1958     ctx->A = NULL;
1959     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1960     pcis->A_BI = pcbddc->benign_original_mat;
1961     pcbddc->benign_original_mat = NULL;
1962     if (ctx->free) {
1963       PetscInt i;
1964       for (i=0;i<ctx->benign_n;i++) {
1965         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1966       }
1967       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1968     }
1969     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1970     ierr = PetscFree(ctx);CHKERRQ(ierr);
1971   }
1972   PetscFunctionReturn(0);
1973 }
1974 
1975 /* used just in bddc debug mode */
1976 #undef __FUNCT__
1977 #define __FUNCT__ "PCBDDCBenignProject"
1978 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1979 {
1980   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1981   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1982   Mat            An;
1983   PetscErrorCode ierr;
1984 
1985   PetscFunctionBegin;
1986   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1987   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1988   if (is1) {
1989     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1990     ierr = MatDestroy(&An);CHKERRQ(ierr);
1991   } else {
1992     *B = An;
1993   }
1994   PetscFunctionReturn(0);
1995 }
1996 
1997 /* TODO: add reuse flag */
1998 #undef __FUNCT__
1999 #define __FUNCT__ "MatSeqAIJCompress"
2000 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2001 {
2002   Mat            Bt;
2003   PetscScalar    *a,*bdata;
2004   const PetscInt *ii,*ij;
2005   PetscInt       m,n,i,nnz,*bii,*bij;
2006   PetscBool      flg_row;
2007   PetscErrorCode ierr;
2008 
2009   PetscFunctionBegin;
2010   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2011   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2012   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2013   nnz = n;
2014   for (i=0;i<ii[n];i++) {
2015     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2016   }
2017   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2018   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2019   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2020   nnz = 0;
2021   bii[0] = 0;
2022   for (i=0;i<n;i++) {
2023     PetscInt j;
2024     for (j=ii[i];j<ii[i+1];j++) {
2025       PetscScalar entry = a[j];
2026       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2027         bij[nnz] = ij[j];
2028         bdata[nnz] = entry;
2029         nnz++;
2030       }
2031     }
2032     bii[i+1] = nnz;
2033   }
2034   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2035   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2036   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2037   {
2038     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2039     b->free_a = PETSC_TRUE;
2040     b->free_ij = PETSC_TRUE;
2041   }
2042   *B = Bt;
2043   PetscFunctionReturn(0);
2044 }
2045 
2046 #undef __FUNCT__
2047 #define __FUNCT__ "MatDetectDisconnectedComponents"
2048 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
2049 {
2050   Mat                    B;
2051   IS                     is_dummy,*cc_n;
2052   ISLocalToGlobalMapping l2gmap_dummy;
2053   PCBDDCGraph            graph;
2054   PetscInt               i,n;
2055   PetscInt               *xadj,*adjncy;
2056   PetscInt               *xadj_filtered,*adjncy_filtered;
2057   PetscBool              flg_row,isseqaij;
2058   PetscErrorCode         ierr;
2059 
2060   PetscFunctionBegin;
2061   if (!A->rmap->N || !A->cmap->N) {
2062     *ncc = 0;
2063     *cc = NULL;
2064     PetscFunctionReturn(0);
2065   }
2066   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2067   if (!isseqaij && filter) {
2068     PetscBool isseqdense;
2069 
2070     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2071     if (!isseqdense) {
2072       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2073     } else { /* TODO: rectangular case and LDA */
2074       PetscScalar *array;
2075       PetscReal   chop=1.e-6;
2076 
2077       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2078       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2079       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2080       for (i=0;i<n;i++) {
2081         PetscInt j;
2082         for (j=i+1;j<n;j++) {
2083           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2084           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2085           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2086         }
2087       }
2088       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2089       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2090     }
2091   } else {
2092     B = A;
2093   }
2094   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2095 
2096   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2097   if (filter) {
2098     PetscScalar *data;
2099     PetscInt    j,cum;
2100 
2101     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2102     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2103     cum = 0;
2104     for (i=0;i<n;i++) {
2105       PetscInt t;
2106 
2107       for (j=xadj[i];j<xadj[i+1];j++) {
2108         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2109           continue;
2110         }
2111         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2112       }
2113       t = xadj_filtered[i];
2114       xadj_filtered[i] = cum;
2115       cum += t;
2116     }
2117     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2118   } else {
2119     xadj_filtered = NULL;
2120     adjncy_filtered = NULL;
2121   }
2122 
2123   /* compute local connected components using PCBDDCGraph */
2124   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2125   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2126   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2127   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2128   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2129   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2130   if (xadj_filtered) {
2131     graph->xadj = xadj_filtered;
2132     graph->adjncy = adjncy_filtered;
2133   } else {
2134     graph->xadj = xadj;
2135     graph->adjncy = adjncy;
2136   }
2137   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2138   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2139   /* partial clean up */
2140   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2141   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2142   if (A != B) {
2143     ierr = MatDestroy(&B);CHKERRQ(ierr);
2144   }
2145 
2146   /* get back data */
2147   if (ncc) *ncc = graph->ncc;
2148   if (cc) {
2149     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2150     for (i=0;i<graph->ncc;i++) {
2151       ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2152     }
2153     *cc = cc_n;
2154   }
2155   /* clean up graph */
2156   graph->xadj = 0;
2157   graph->adjncy = 0;
2158   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2159   PetscFunctionReturn(0);
2160 }
2161 
2162 #undef __FUNCT__
2163 #define __FUNCT__ "PCBDDCBenignCheck"
2164 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2165 {
2166   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2167   PC_IS*         pcis = (PC_IS*)(pc->data);
2168   IS             dirIS = NULL;
2169   PetscInt       i;
2170   PetscErrorCode ierr;
2171 
2172   PetscFunctionBegin;
2173   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2174   if (zerodiag) {
2175     Mat            A;
2176     Vec            vec3_N;
2177     PetscScalar    *vals;
2178     const PetscInt *idxs;
2179     PetscInt       nz,*count;
2180 
2181     /* p0 */
2182     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2183     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2184     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2185     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2186     for (i=0;i<nz;i++) vals[i] = 1.;
2187     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2188     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2189     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2190     /* v_I */
2191     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2192     for (i=0;i<nz;i++) vals[i] = 0.;
2193     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2194     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2195     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2196     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2197     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2198     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2199     if (dirIS) {
2200       PetscInt n;
2201 
2202       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2203       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2204       for (i=0;i<n;i++) vals[i] = 0.;
2205       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2206       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2207     }
2208     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2209     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2210     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2211     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2212     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2213     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2214     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2215     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2216     ierr = PetscFree(vals);CHKERRQ(ierr);
2217     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2218 
2219     /* there should not be any pressure dofs lying on the interface */
2220     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2221     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2222     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2223     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2224     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2225     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2226     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2227     ierr = PetscFree(count);CHKERRQ(ierr);
2228   }
2229   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2230 
2231   /* check PCBDDCBenignGetOrSetP0 */
2232   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2233   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2234   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2235   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2236   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2237   for (i=0;i<pcbddc->benign_n;i++) {
2238     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2239     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2240   }
2241   PetscFunctionReturn(0);
2242 }
2243 
2244 #undef __FUNCT__
2245 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
2246 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2247 {
2248   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2249   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2250   PetscInt       nz,n;
2251   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2252   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2253   PetscErrorCode ierr;
2254 
2255   PetscFunctionBegin;
2256   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2257   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2258   for (n=0;n<pcbddc->benign_n;n++) {
2259     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2260   }
2261   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2262   pcbddc->benign_n = 0;
2263 
2264   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2265      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2266      Checks if all the pressure dofs in each subdomain have a zero diagonal
2267      If not, a change of basis on pressures is not needed
2268      since the local Schur complements are already SPD
2269   */
2270   has_null_pressures = PETSC_TRUE;
2271   have_null = PETSC_TRUE;
2272   if (pcbddc->n_ISForDofsLocal) {
2273     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2274 
2275     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2276     ierr = PetscOptionsInt ("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2277     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2278     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2279     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2280     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2281     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2282     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2283     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2284     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2285     if (!sorted) {
2286       ierr = ISSort(pressures);CHKERRQ(ierr);
2287     }
2288   } else {
2289     pressures = NULL;
2290   }
2291   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2292   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2293   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2294   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2295   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2296   if (!sorted) {
2297     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2298   }
2299   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2300   zerodiag_save = zerodiag;
2301   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2302   if (!nz) {
2303     if (n) have_null = PETSC_FALSE;
2304     has_null_pressures = PETSC_FALSE;
2305     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2306   }
2307   recompute_zerodiag = PETSC_FALSE;
2308   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2309   zerodiag_subs    = NULL;
2310   pcbddc->benign_n = 0;
2311   n_interior_dofs  = 0;
2312   interior_dofs    = NULL;
2313   nneu             = 0;
2314   if (pcbddc->NeumannBoundariesLocal) {
2315     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2316   }
2317   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2318   if (checkb) { /* need to compute interior nodes */
2319     PetscInt n,i,j;
2320     PetscInt n_neigh,*neigh,*n_shared,**shared;
2321     PetscInt *iwork;
2322 
2323     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2324     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2325     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2326     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2327     for (i=1;i<n_neigh;i++)
2328       for (j=0;j<n_shared[i];j++)
2329           iwork[shared[i][j]] += 1;
2330     for (i=0;i<n;i++)
2331       if (!iwork[i])
2332         interior_dofs[n_interior_dofs++] = i;
2333     ierr = PetscFree(iwork);CHKERRQ(ierr);
2334     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2335   }
2336   if (has_null_pressures) {
2337     IS             *subs;
2338     PetscInt       nsubs,i,j,nl;
2339     const PetscInt *idxs;
2340     PetscScalar    *array;
2341     Vec            *work;
2342     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2343 
2344     subs  = pcbddc->local_subs;
2345     nsubs = pcbddc->n_local_subs;
2346     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2347     if (checkb) {
2348       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2349       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2350       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2351       /* work[0] = 1_p */
2352       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2353       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2354       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2355       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2356       /* work[0] = 1_v */
2357       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2358       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2359       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2360       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2361       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2362     }
2363     if (nsubs > 1) {
2364       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2365       for (i=0;i<nsubs;i++) {
2366         ISLocalToGlobalMapping l2g;
2367         IS                     t_zerodiag_subs;
2368         PetscInt               nl;
2369 
2370         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2371         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2372         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2373         if (nl) {
2374           PetscBool valid = PETSC_TRUE;
2375 
2376           if (checkb) {
2377             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2378             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2379             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2380             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2381             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2382             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2383             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2384             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2385             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2386             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2387             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2388             for (j=0;j<n_interior_dofs;j++) {
2389               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2390                 valid = PETSC_FALSE;
2391                 break;
2392               }
2393             }
2394             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2395           }
2396           if (valid && nneu) {
2397             const PetscInt *idxs;
2398             PetscInt       nzb;
2399 
2400             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2401             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2402             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2403             if (nzb) valid = PETSC_FALSE;
2404           }
2405           if (valid && pressures) {
2406             IS t_pressure_subs;
2407             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2408             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2409             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2410           }
2411           if (valid) {
2412             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2413             pcbddc->benign_n++;
2414           } else {
2415             recompute_zerodiag = PETSC_TRUE;
2416           }
2417         }
2418         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2419         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2420       }
2421     } else { /* there's just one subdomain (or zero if they have not been detected */
2422       PetscBool valid = PETSC_TRUE;
2423 
2424       if (nneu) valid = PETSC_FALSE;
2425       if (valid && pressures) {
2426         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2427       }
2428       if (valid && checkb) {
2429         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2430         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2431         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2432         for (j=0;j<n_interior_dofs;j++) {
2433           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2434             valid = PETSC_FALSE;
2435             break;
2436           }
2437         }
2438         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2439       }
2440       if (valid) {
2441         pcbddc->benign_n = 1;
2442         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2443         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2444         zerodiag_subs[0] = zerodiag;
2445       }
2446     }
2447     if (checkb) {
2448       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2449     }
2450   }
2451   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2452 
2453   if (!pcbddc->benign_n) {
2454     PetscInt n;
2455 
2456     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2457     recompute_zerodiag = PETSC_FALSE;
2458     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2459     if (n) {
2460       has_null_pressures = PETSC_FALSE;
2461       have_null = PETSC_FALSE;
2462     }
2463   }
2464 
2465   /* final check for null pressures */
2466   if (zerodiag && pressures) {
2467     PetscInt nz,np;
2468     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2469     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2470     if (nz != np) have_null = PETSC_FALSE;
2471   }
2472 
2473   if (recompute_zerodiag) {
2474     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2475     if (pcbddc->benign_n == 1) {
2476       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2477       zerodiag = zerodiag_subs[0];
2478     } else {
2479       PetscInt i,nzn,*new_idxs;
2480 
2481       nzn = 0;
2482       for (i=0;i<pcbddc->benign_n;i++) {
2483         PetscInt ns;
2484         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2485         nzn += ns;
2486       }
2487       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2488       nzn = 0;
2489       for (i=0;i<pcbddc->benign_n;i++) {
2490         PetscInt ns,*idxs;
2491         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2492         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2493         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2494         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2495         nzn += ns;
2496       }
2497       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2498       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2499     }
2500     have_null = PETSC_FALSE;
2501   }
2502 
2503   /* Prepare matrix to compute no-net-flux */
2504   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2505     Mat                    A,loc_divudotp;
2506     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2507     IS                     row,col,isused = NULL;
2508     PetscInt               M,N,n,st,n_isused;
2509 
2510     if (pressures) {
2511       isused = pressures;
2512     } else {
2513       isused = zerodiag_save;
2514     }
2515     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2516     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2517     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2518     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2519     n_isused = 0;
2520     if (isused) {
2521       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2522     }
2523     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2524     st = st-n_isused;
2525     if (n) {
2526       const PetscInt *gidxs;
2527 
2528       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2529       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2530       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2531       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2532       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2533       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2534     } else {
2535       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2536       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2537       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2538     }
2539     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2540     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2541     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2542     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2543     ierr = ISDestroy(&row);CHKERRQ(ierr);
2544     ierr = ISDestroy(&col);CHKERRQ(ierr);
2545     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2546     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2547     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2548     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2549     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2550     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2551     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2552     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2553     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2554     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2555   }
2556   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2557 
2558   /* change of basis and p0 dofs */
2559   if (has_null_pressures) {
2560     IS             zerodiagc;
2561     const PetscInt *idxs,*idxsc;
2562     PetscInt       i,s,*nnz;
2563 
2564     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2565     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2566     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2567     /* local change of basis for pressures */
2568     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2569     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2570     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2571     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2572     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2573     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2574     for (i=0;i<pcbddc->benign_n;i++) {
2575       PetscInt nzs,j;
2576 
2577       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2578       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2579       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2580       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2581       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2582     }
2583     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2584     ierr = PetscFree(nnz);CHKERRQ(ierr);
2585     /* set identity on velocities */
2586     for (i=0;i<n-nz;i++) {
2587       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2588     }
2589     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2590     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2591     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2592     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2593     /* set change on pressures */
2594     for (s=0;s<pcbddc->benign_n;s++) {
2595       PetscScalar *array;
2596       PetscInt    nzs;
2597 
2598       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2599       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2600       for (i=0;i<nzs-1;i++) {
2601         PetscScalar vals[2];
2602         PetscInt    cols[2];
2603 
2604         cols[0] = idxs[i];
2605         cols[1] = idxs[nzs-1];
2606         vals[0] = 1.;
2607         vals[1] = 1.;
2608         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2609       }
2610       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2611       for (i=0;i<nzs-1;i++) array[i] = -1.;
2612       array[nzs-1] = 1.;
2613       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2614       /* store local idxs for p0 */
2615       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2616       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2617       ierr = PetscFree(array);CHKERRQ(ierr);
2618     }
2619     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2620     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2621     /* project if needed */
2622     if (pcbddc->benign_change_explicit) {
2623       Mat M;
2624 
2625       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2626       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2627       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2628       ierr = MatDestroy(&M);CHKERRQ(ierr);
2629     }
2630     /* store global idxs for p0 */
2631     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2632   }
2633   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2634   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2635 
2636   /* determines if the coarse solver will be singular or not */
2637   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2638   /* determines if the problem has subdomains with 0 pressure block */
2639   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2640   *zerodiaglocal = zerodiag;
2641   PetscFunctionReturn(0);
2642 }
2643 
2644 #undef __FUNCT__
2645 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
2646 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2647 {
2648   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2649   PetscScalar    *array;
2650   PetscErrorCode ierr;
2651 
2652   PetscFunctionBegin;
2653   if (!pcbddc->benign_sf) {
2654     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2655     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2656   }
2657   if (get) {
2658     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2659     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2660     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2661     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2662   } else {
2663     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2664     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2665     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2666     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2667   }
2668   PetscFunctionReturn(0);
2669 }
2670 
2671 #undef __FUNCT__
2672 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
2673 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2674 {
2675   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2676   PetscErrorCode ierr;
2677 
2678   PetscFunctionBegin;
2679   /* TODO: add error checking
2680     - avoid nested pop (or push) calls.
2681     - cannot push before pop.
2682     - cannot call this if pcbddc->local_mat is NULL
2683   */
2684   if (!pcbddc->benign_n) {
2685     PetscFunctionReturn(0);
2686   }
2687   if (pop) {
2688     if (pcbddc->benign_change_explicit) {
2689       IS       is_p0;
2690       MatReuse reuse;
2691 
2692       /* extract B_0 */
2693       reuse = MAT_INITIAL_MATRIX;
2694       if (pcbddc->benign_B0) {
2695         reuse = MAT_REUSE_MATRIX;
2696       }
2697       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2698       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2699       /* remove rows and cols from local problem */
2700       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2701       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2702       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2703       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2704     } else {
2705       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2706       PetscScalar *vals;
2707       PetscInt    i,n,*idxs_ins;
2708 
2709       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2710       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2711       if (!pcbddc->benign_B0) {
2712         PetscInt *nnz;
2713         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2714         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2715         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2716         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2717         for (i=0;i<pcbddc->benign_n;i++) {
2718           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2719           nnz[i] = n - nnz[i];
2720         }
2721         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2722         ierr = PetscFree(nnz);CHKERRQ(ierr);
2723       }
2724 
2725       for (i=0;i<pcbddc->benign_n;i++) {
2726         PetscScalar *array;
2727         PetscInt    *idxs,j,nz,cum;
2728 
2729         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2730         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2731         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2732         for (j=0;j<nz;j++) vals[j] = 1.;
2733         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2734         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2735         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2736         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2737         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2738         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2739         cum = 0;
2740         for (j=0;j<n;j++) {
2741           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2742             vals[cum] = array[j];
2743             idxs_ins[cum] = j;
2744             cum++;
2745           }
2746         }
2747         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2748         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2749         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2750       }
2751       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2752       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2753       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2754     }
2755   } else { /* push */
2756     if (pcbddc->benign_change_explicit) {
2757       PetscInt i;
2758 
2759       for (i=0;i<pcbddc->benign_n;i++) {
2760         PetscScalar *B0_vals;
2761         PetscInt    *B0_cols,B0_ncol;
2762 
2763         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2764         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2765         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2766         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2767         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2768       }
2769       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2770       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2771     } else {
2772       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2773     }
2774   }
2775   PetscFunctionReturn(0);
2776 }
2777 
2778 #undef __FUNCT__
2779 #define __FUNCT__ "PCBDDCAdaptiveSelection"
2780 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2781 {
2782   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2783   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2784   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2785   PetscBLASInt    *B_iwork,*B_ifail;
2786   PetscScalar     *work,lwork;
2787   PetscScalar     *St,*S,*eigv;
2788   PetscScalar     *Sarray,*Starray;
2789   PetscReal       *eigs,thresh;
2790   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2791   PetscBool       allocated_S_St;
2792 #if defined(PETSC_USE_COMPLEX)
2793   PetscReal       *rwork;
2794 #endif
2795   PetscErrorCode  ierr;
2796 
2797   PetscFunctionBegin;
2798   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2799   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2800   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\n",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2801 
2802   if (pcbddc->dbg_flag) {
2803     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2804     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2806     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2807   }
2808 
2809   if (pcbddc->dbg_flag) {
2810     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2811   }
2812 
2813   /* max size of subsets */
2814   mss = 0;
2815   for (i=0;i<sub_schurs->n_subs;i++) {
2816     PetscInt subset_size;
2817 
2818     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2819     mss = PetscMax(mss,subset_size);
2820   }
2821 
2822   /* min/max and threshold */
2823   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2824   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2825   nmax = PetscMax(nmin,nmax);
2826   allocated_S_St = PETSC_FALSE;
2827   if (nmin) {
2828     allocated_S_St = PETSC_TRUE;
2829   }
2830 
2831   /* allocate lapack workspace */
2832   cum = cum2 = 0;
2833   maxneigs = 0;
2834   for (i=0;i<sub_schurs->n_subs;i++) {
2835     PetscInt n,subset_size;
2836 
2837     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2838     n = PetscMin(subset_size,nmax);
2839     cum += subset_size;
2840     cum2 += subset_size*n;
2841     maxneigs = PetscMax(maxneigs,n);
2842   }
2843   if (mss) {
2844     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2845       PetscBLASInt B_itype = 1;
2846       PetscBLASInt B_N = mss;
2847       PetscReal    zero = 0.0;
2848       PetscReal    eps = 0.0; /* dlamch? */
2849 
2850       B_lwork = -1;
2851       S = NULL;
2852       St = NULL;
2853       eigs = NULL;
2854       eigv = NULL;
2855       B_iwork = NULL;
2856       B_ifail = NULL;
2857 #if defined(PETSC_USE_COMPLEX)
2858       rwork = NULL;
2859 #endif
2860       thresh = 1.0;
2861       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2862 #if defined(PETSC_USE_COMPLEX)
2863       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
2864 #else
2865       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
2866 #endif
2867       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2868       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2869     } else {
2870         /* TODO */
2871     }
2872   } else {
2873     lwork = 0;
2874   }
2875 
2876   nv = 0;
2877   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
2878     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2879   }
2880   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2881   if (allocated_S_St) {
2882     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2883   }
2884   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2885 #if defined(PETSC_USE_COMPLEX)
2886   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2887 #endif
2888   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2889                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2890                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2891                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2892                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2893   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2894 
2895   maxneigs = 0;
2896   cum = cumarray = 0;
2897   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2898   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2899   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2900     const PetscInt *idxs;
2901 
2902     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2903     for (cum=0;cum<nv;cum++) {
2904       pcbddc->adaptive_constraints_n[cum] = 1;
2905       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2906       pcbddc->adaptive_constraints_data[cum] = 1.0;
2907       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2908       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2909     }
2910     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2911   }
2912 
2913   if (mss) { /* multilevel */
2914     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2915     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2916   }
2917 
2918   thresh = pcbddc->adaptive_threshold;
2919   for (i=0;i<sub_schurs->n_subs;i++) {
2920     const PetscInt *idxs;
2921     PetscReal      upper,lower;
2922     PetscInt       j,subset_size,eigs_start = 0;
2923     PetscBLASInt   B_N;
2924     PetscBool      same_data = PETSC_FALSE;
2925 
2926     if (pcbddc->use_deluxe_scaling) {
2927       upper = PETSC_MAX_REAL;
2928       lower = thresh;
2929     } else {
2930       upper = 1./thresh;
2931       lower = 0.;
2932     }
2933     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2934     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2935     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2936     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2937       if (sub_schurs->is_hermitian) {
2938         PetscInt j,k;
2939         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2940           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2941           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2942         }
2943         for (j=0;j<subset_size;j++) {
2944           for (k=j;k<subset_size;k++) {
2945             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2946             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2947           }
2948         }
2949       } else {
2950         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2951         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2952       }
2953     } else {
2954       S = Sarray + cumarray;
2955       St = Starray + cumarray;
2956     }
2957     /* see if we can save some work */
2958     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2959       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2960     }
2961 
2962     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2963       B_neigs = 0;
2964     } else {
2965       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2966         PetscBLASInt B_itype = 1;
2967         PetscBLASInt B_IL, B_IU;
2968         PetscReal    eps = -1.0; /* dlamch? */
2969         PetscInt     nmin_s;
2970         PetscBool    compute_range = PETSC_FALSE;
2971 
2972         if (pcbddc->dbg_flag) {
2973           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
2974         }
2975 
2976         compute_range = PETSC_FALSE;
2977         if (thresh > 1.+PETSC_SMALL && !same_data) {
2978           compute_range = PETSC_TRUE;
2979         }
2980 
2981         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2982         if (compute_range) {
2983 
2984           /* ask for eigenvalues larger than thresh */
2985 #if defined(PETSC_USE_COMPLEX)
2986           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
2987 #else
2988           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
2989 #endif
2990         } else if (!same_data) {
2991           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2992           B_IL = 1;
2993 #if defined(PETSC_USE_COMPLEX)
2994           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
2995 #else
2996           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
2997 #endif
2998         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2999           PetscInt k;
3000           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3001           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3002           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3003           nmin = nmax;
3004           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3005           for (k=0;k<nmax;k++) {
3006             eigs[k] = 1./PETSC_SMALL;
3007             eigv[k*(subset_size+1)] = 1.0;
3008           }
3009         }
3010         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3011         if (B_ierr) {
3012           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3013           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3014           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3015         }
3016 
3017         if (B_neigs > nmax) {
3018           if (pcbddc->dbg_flag) {
3019             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3020           }
3021           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3022           B_neigs = nmax;
3023         }
3024 
3025         nmin_s = PetscMin(nmin,B_N);
3026         if (B_neigs < nmin_s) {
3027           PetscBLASInt B_neigs2;
3028 
3029           if (pcbddc->use_deluxe_scaling) {
3030             B_IL = B_N - nmin_s + 1;
3031             B_IU = B_N - B_neigs;
3032           } else {
3033             B_IL = B_neigs + 1;
3034             B_IU = nmin_s;
3035           }
3036           if (pcbddc->dbg_flag) {
3037             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
3038           }
3039           if (sub_schurs->is_hermitian) {
3040             PetscInt j,k;
3041             for (j=0;j<subset_size;j++) {
3042               for (k=j;k<subset_size;k++) {
3043                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3044                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3045               }
3046             }
3047           } else {
3048             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3049             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3050           }
3051           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3052 #if defined(PETSC_USE_COMPLEX)
3053           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3054 #else
3055           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3056 #endif
3057           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3058           B_neigs += B_neigs2;
3059         }
3060         if (B_ierr) {
3061           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3062           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3063           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3064         }
3065         if (pcbddc->dbg_flag) {
3066           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3067           for (j=0;j<B_neigs;j++) {
3068             if (eigs[j] == 0.0) {
3069               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3070             } else {
3071               if (pcbddc->use_deluxe_scaling) {
3072                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3073               } else {
3074                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3075               }
3076             }
3077           }
3078         }
3079       } else {
3080           /* TODO */
3081       }
3082     }
3083     /* change the basis back to the original one */
3084     if (sub_schurs->change) {
3085       Mat change,phi,phit;
3086 
3087       if (pcbddc->dbg_flag > 1) {
3088         PetscInt ii;
3089         for (ii=0;ii<B_neigs;ii++) {
3090           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3091           for (j=0;j<B_N;j++) {
3092 #if defined(PETSC_USE_COMPLEX)
3093             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3094             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3095             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3096 #else
3097             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3098 #endif
3099           }
3100         }
3101       }
3102       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3103       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3104       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3105       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3106       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3107       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3108     }
3109     maxneigs = PetscMax(B_neigs,maxneigs);
3110     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3111     if (B_neigs) {
3112       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3113 
3114       if (pcbddc->dbg_flag > 1) {
3115         PetscInt ii;
3116         for (ii=0;ii<B_neigs;ii++) {
3117           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3118           for (j=0;j<B_N;j++) {
3119 #if defined(PETSC_USE_COMPLEX)
3120             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3121             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3122             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3123 #else
3124             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3125 #endif
3126           }
3127         }
3128       }
3129       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3130       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3131       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3132       cum++;
3133     }
3134     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3135     /* shift for next computation */
3136     cumarray += subset_size*subset_size;
3137   }
3138   if (pcbddc->dbg_flag) {
3139     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3140   }
3141 
3142   if (mss) {
3143     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3144     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3145     /* destroy matrices (junk) */
3146     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3147     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3148   }
3149   if (allocated_S_St) {
3150     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3151   }
3152   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3153 #if defined(PETSC_USE_COMPLEX)
3154   ierr = PetscFree(rwork);CHKERRQ(ierr);
3155 #endif
3156   if (pcbddc->dbg_flag) {
3157     PetscInt maxneigs_r;
3158     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3159     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3160   }
3161   PetscFunctionReturn(0);
3162 }
3163 
3164 #undef __FUNCT__
3165 #define __FUNCT__ "PCBDDCSetUpSolvers"
3166 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3167 {
3168   PetscScalar    *coarse_submat_vals;
3169   PetscErrorCode ierr;
3170 
3171   PetscFunctionBegin;
3172   /* Setup local scatters R_to_B and (optionally) R_to_D */
3173   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3174   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3175 
3176   /* Setup local neumann solver ksp_R */
3177   /* PCBDDCSetUpLocalScatters should be called first! */
3178   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3179 
3180   /*
3181      Setup local correction and local part of coarse basis.
3182      Gives back the dense local part of the coarse matrix in column major ordering
3183   */
3184   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3185 
3186   /* Compute total number of coarse nodes and setup coarse solver */
3187   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3188 
3189   /* free */
3190   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3191   PetscFunctionReturn(0);
3192 }
3193 
3194 #undef __FUNCT__
3195 #define __FUNCT__ "PCBDDCResetCustomization"
3196 PetscErrorCode PCBDDCResetCustomization(PC pc)
3197 {
3198   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3199   PetscErrorCode ierr;
3200 
3201   PetscFunctionBegin;
3202   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3203   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3204   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3205   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3206   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3207   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3208   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3209   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3210   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3211   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3212   PetscFunctionReturn(0);
3213 }
3214 
3215 #undef __FUNCT__
3216 #define __FUNCT__ "PCBDDCResetTopography"
3217 PetscErrorCode PCBDDCResetTopography(PC pc)
3218 {
3219   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3220   PetscInt       i;
3221   PetscErrorCode ierr;
3222 
3223   PetscFunctionBegin;
3224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3226   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3227   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3228   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3229   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3230   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3231   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3232   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3233   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3234   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
3235   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
3236   for (i=0;i<pcbddc->n_local_subs;i++) {
3237     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3238   }
3239   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3240   if (pcbddc->sub_schurs) {
3241     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
3242   }
3243   pcbddc->graphanalyzed        = PETSC_FALSE;
3244   pcbddc->recompute_topography = PETSC_TRUE;
3245   PetscFunctionReturn(0);
3246 }
3247 
3248 #undef __FUNCT__
3249 #define __FUNCT__ "PCBDDCResetSolvers"
3250 PetscErrorCode PCBDDCResetSolvers(PC pc)
3251 {
3252   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3253   PetscErrorCode ierr;
3254 
3255   PetscFunctionBegin;
3256   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3257   if (pcbddc->coarse_phi_B) {
3258     PetscScalar *array;
3259     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3260     ierr = PetscFree(array);CHKERRQ(ierr);
3261   }
3262   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3263   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3264   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3265   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3266   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3267   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3268   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3269   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3270   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3271   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3272   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3273   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3274   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3275   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3276   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
3277   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
3278   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
3279   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3280   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3281   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3282   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3283   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3284   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3285   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3286   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3287   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3288   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3289   if (pcbddc->benign_zerodiag_subs) {
3290     PetscInt i;
3291     for (i=0;i<pcbddc->benign_n;i++) {
3292       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3293     }
3294     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3295   }
3296   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3297   PetscFunctionReturn(0);
3298 }
3299 
3300 #undef __FUNCT__
3301 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
3302 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3303 {
3304   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3305   PC_IS          *pcis = (PC_IS*)pc->data;
3306   VecType        impVecType;
3307   PetscInt       n_constraints,n_R,old_size;
3308   PetscErrorCode ierr;
3309 
3310   PetscFunctionBegin;
3311   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3312   n_R = pcis->n - pcbddc->n_vertices;
3313   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3314   /* local work vectors (try to avoid unneeded work)*/
3315   /* R nodes */
3316   old_size = -1;
3317   if (pcbddc->vec1_R) {
3318     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3319   }
3320   if (n_R != old_size) {
3321     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3322     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3323     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3324     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3325     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3326     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3327   }
3328   /* local primal dofs */
3329   old_size = -1;
3330   if (pcbddc->vec1_P) {
3331     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3332   }
3333   if (pcbddc->local_primal_size != old_size) {
3334     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3335     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3336     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3337     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3338   }
3339   /* local explicit constraints */
3340   old_size = -1;
3341   if (pcbddc->vec1_C) {
3342     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3343   }
3344   if (n_constraints && n_constraints != old_size) {
3345     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3346     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3347     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3348     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3349   }
3350   PetscFunctionReturn(0);
3351 }
3352 
3353 #undef __FUNCT__
3354 #define __FUNCT__ "PCBDDCSetUpCorrection"
3355 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3356 {
3357   PetscErrorCode  ierr;
3358   /* pointers to pcis and pcbddc */
3359   PC_IS*          pcis = (PC_IS*)pc->data;
3360   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3361   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3362   /* submatrices of local problem */
3363   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3364   /* submatrices of local coarse problem */
3365   Mat             S_VV,S_CV,S_VC,S_CC;
3366   /* working matrices */
3367   Mat             C_CR;
3368   /* additional working stuff */
3369   PC              pc_R;
3370   Mat             F;
3371   Vec             dummy_vec;
3372   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3373   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3374   PetscScalar     *work;
3375   PetscInt        *idx_V_B;
3376   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3377   PetscInt        i,n_R,n_D,n_B;
3378 
3379   /* some shortcuts to scalars */
3380   PetscScalar     one=1.0,m_one=-1.0;
3381 
3382   PetscFunctionBegin;
3383   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3384 
3385   /* Set Non-overlapping dimensions */
3386   n_vertices = pcbddc->n_vertices;
3387   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3388   n_B = pcis->n_B;
3389   n_D = pcis->n - n_B;
3390   n_R = pcis->n - n_vertices;
3391 
3392   /* vertices in boundary numbering */
3393   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3394   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3395   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3396 
3397   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3398   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3399   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3400   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3401   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3402   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3403   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3404   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3405   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3406   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3407 
3408   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3409   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3410   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3411   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3412   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3413   lda_rhs = n_R;
3414   need_benign_correction = PETSC_FALSE;
3415   if (isLU || isILU || isCHOL) {
3416     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3417   } else if (sub_schurs && sub_schurs->reuse_solver) {
3418     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3419     MatFactorType      type;
3420 
3421     F = reuse_solver->F;
3422     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3423     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3424     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3425     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3426   } else {
3427     F = NULL;
3428   }
3429 
3430   /* allocate workspace */
3431   n = 0;
3432   if (n_constraints) {
3433     n += lda_rhs*n_constraints;
3434   }
3435   if (n_vertices) {
3436     n = PetscMax(2*lda_rhs*n_vertices,n);
3437     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3438   }
3439   if (!pcbddc->symmetric_primal) {
3440     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3441   }
3442   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3443 
3444   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3445   dummy_vec = NULL;
3446   if (need_benign_correction && lda_rhs != n_R && F) {
3447     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3448   }
3449 
3450   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3451   if (n_constraints) {
3452     Mat         M1,M2,M3,C_B;
3453     IS          is_aux;
3454     PetscScalar *array,*array2;
3455 
3456     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3457     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3458 
3459     /* Extract constraints on R nodes: C_{CR}  */
3460     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3461     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3462     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3463 
3464     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3465     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3466     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3467     for (i=0;i<n_constraints;i++) {
3468       const PetscScalar *row_cmat_values;
3469       const PetscInt    *row_cmat_indices;
3470       PetscInt          size_of_constraint,j;
3471 
3472       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3473       for (j=0;j<size_of_constraint;j++) {
3474         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3475       }
3476       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3477     }
3478     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3479     if (F) {
3480       Mat B;
3481 
3482       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3483       if (need_benign_correction) {
3484         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3485 
3486         /* rhs is already zero on interior dofs, no need to change the rhs */
3487         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3488       }
3489       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3490       if (need_benign_correction) {
3491         PetscScalar        *marr;
3492         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3493 
3494         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3495         if (lda_rhs != n_R) {
3496           for (i=0;i<n_constraints;i++) {
3497             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3498             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3499             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3500           }
3501         } else {
3502           for (i=0;i<n_constraints;i++) {
3503             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3504             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3505             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3506           }
3507         }
3508         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3509       }
3510       ierr = MatDestroy(&B);CHKERRQ(ierr);
3511     } else {
3512       PetscScalar *marr;
3513 
3514       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3515       for (i=0;i<n_constraints;i++) {
3516         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3517         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3518         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3519         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3520         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3521       }
3522       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3523     }
3524     if (!pcbddc->switch_static) {
3525       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3526       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3527       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3528       for (i=0;i<n_constraints;i++) {
3529         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3530         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3531         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3532         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3533         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3534         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3535       }
3536       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3537       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3538       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3539     } else {
3540       if (lda_rhs != n_R) {
3541         IS dummy;
3542 
3543         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3544         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3545         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3546       } else {
3547         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3548         pcbddc->local_auxmat2 = local_auxmat2_R;
3549       }
3550       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3551     }
3552     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3553     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3554     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3555     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3556     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3557     if (isCHOL) {
3558       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3559     } else {
3560       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3561     }
3562     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3563     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3564     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3565     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3566     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3567     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3568     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3569     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3570     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3571     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3572   }
3573 
3574   /* Get submatrices from subdomain matrix */
3575   if (n_vertices) {
3576     IS is_aux;
3577 
3578     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3579       IS tis;
3580 
3581       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3582       ierr = ISSort(tis);CHKERRQ(ierr);
3583       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3584       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3585     } else {
3586       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3587     }
3588     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3589     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3590     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3591     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3592   }
3593 
3594   /* Matrix of coarse basis functions (local) */
3595   if (pcbddc->coarse_phi_B) {
3596     PetscInt on_B,on_primal,on_D=n_D;
3597     if (pcbddc->coarse_phi_D) {
3598       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3599     }
3600     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3601     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3602       PetscScalar *marray;
3603 
3604       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3605       ierr = PetscFree(marray);CHKERRQ(ierr);
3606       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3607       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3608       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3609       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3610     }
3611   }
3612 
3613   if (!pcbddc->coarse_phi_B) {
3614     PetscScalar *marr;
3615 
3616     /* memory size */
3617     n = n_B*pcbddc->local_primal_size;
3618     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3619     if (!pcbddc->symmetric_primal) n *= 2;
3620     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3621     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3622     marr += n_B*pcbddc->local_primal_size;
3623     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3624       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3625       marr += n_D*pcbddc->local_primal_size;
3626     }
3627     if (!pcbddc->symmetric_primal) {
3628       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3629       marr += n_B*pcbddc->local_primal_size;
3630       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3631         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3632       }
3633     } else {
3634       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3635       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3636       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3637         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3638         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3639       }
3640     }
3641   }
3642 
3643   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3644   p0_lidx_I = NULL;
3645   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3646     const PetscInt *idxs;
3647 
3648     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3649     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3650     for (i=0;i<pcbddc->benign_n;i++) {
3651       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3652     }
3653     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3654   }
3655 
3656   /* vertices */
3657   if (n_vertices) {
3658 
3659     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3660 
3661     if (n_R) {
3662       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3663       PetscBLASInt B_N,B_one = 1;
3664       PetscScalar  *x,*y;
3665       PetscBool    isseqaij;
3666 
3667       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3668       if (need_benign_correction) {
3669         ISLocalToGlobalMapping RtoN;
3670         IS                     is_p0;
3671         PetscInt               *idxs_p0,n;
3672 
3673         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3674         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3675         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3676         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3677         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3678         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3679         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3680         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3681       }
3682 
3683       if (lda_rhs == n_R) {
3684         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3685       } else {
3686         PetscScalar    *av,*array;
3687         const PetscInt *xadj,*adjncy;
3688         PetscInt       n;
3689         PetscBool      flg_row;
3690 
3691         array = work+lda_rhs*n_vertices;
3692         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3693         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3694         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3695         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3696         for (i=0;i<n;i++) {
3697           PetscInt j;
3698           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3699         }
3700         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3701         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3702         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3703       }
3704       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3705       if (need_benign_correction) {
3706         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3707         PetscScalar        *marr;
3708 
3709         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3710         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3711 
3712                | 0 0  0 | (V)
3713            L = | 0 0 -1 | (P-p0)
3714                | 0 0 -1 | (p0)
3715 
3716         */
3717         for (i=0;i<reuse_solver->benign_n;i++) {
3718           const PetscScalar *vals;
3719           const PetscInt    *idxs,*idxs_zero;
3720           PetscInt          n,j,nz;
3721 
3722           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3723           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3724           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3725           for (j=0;j<n;j++) {
3726             PetscScalar val = vals[j];
3727             PetscInt    k,col = idxs[j];
3728             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3729           }
3730           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3731           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3732         }
3733         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3734       }
3735       if (F) {
3736         /* need to correct the rhs */
3737         if (need_benign_correction) {
3738           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3739           PetscScalar        *marr;
3740 
3741           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3742           if (lda_rhs != n_R) {
3743             for (i=0;i<n_vertices;i++) {
3744               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3745               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3746               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3747             }
3748           } else {
3749             for (i=0;i<n_vertices;i++) {
3750               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3751               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3752               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3753             }
3754           }
3755           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3756         }
3757         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3758         /* need to correct the solution */
3759         if (need_benign_correction) {
3760           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3761           PetscScalar        *marr;
3762 
3763           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3764           if (lda_rhs != n_R) {
3765             for (i=0;i<n_vertices;i++) {
3766               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3767               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3768               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3769             }
3770           } else {
3771             for (i=0;i<n_vertices;i++) {
3772               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3773               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3774               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3775             }
3776           }
3777           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3778         }
3779       } else {
3780         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3781         for (i=0;i<n_vertices;i++) {
3782           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3783           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3784           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3785           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3786           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3787         }
3788         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3789       }
3790       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3791       /* S_VV and S_CV */
3792       if (n_constraints) {
3793         Mat B;
3794 
3795         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3796         for (i=0;i<n_vertices;i++) {
3797           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3798           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3799           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3800           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3801           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3802           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3803         }
3804         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3805         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3806         ierr = MatDestroy(&B);CHKERRQ(ierr);
3807         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3808         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3809         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3810         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3811         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3812         ierr = MatDestroy(&B);CHKERRQ(ierr);
3813       }
3814       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3815       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3816         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3817       }
3818       if (lda_rhs != n_R) {
3819         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3820         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3821         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3822       }
3823       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3824       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3825       if (need_benign_correction) {
3826         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3827         PetscScalar      *marr,*sums;
3828 
3829         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3830         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3831         for (i=0;i<reuse_solver->benign_n;i++) {
3832           const PetscScalar *vals;
3833           const PetscInt    *idxs,*idxs_zero;
3834           PetscInt          n,j,nz;
3835 
3836           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3837           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3838           for (j=0;j<n_vertices;j++) {
3839             PetscInt k;
3840             sums[j] = 0.;
3841             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3842           }
3843           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3844           for (j=0;j<n;j++) {
3845             PetscScalar val = vals[j];
3846             PetscInt k;
3847             for (k=0;k<n_vertices;k++) {
3848               marr[idxs[j]+k*n_vertices] += val*sums[k];
3849             }
3850           }
3851           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3852           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3853         }
3854         ierr = PetscFree(sums);CHKERRQ(ierr);
3855         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3856         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3857       }
3858       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3859       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3860       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3861       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3862       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3863       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3864       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3865       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3866       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3867     } else {
3868       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3869     }
3870     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3871 
3872     /* coarse basis functions */
3873     for (i=0;i<n_vertices;i++) {
3874       PetscScalar *y;
3875 
3876       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3877       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3878       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3879       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3880       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3881       y[n_B*i+idx_V_B[i]] = 1.0;
3882       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3883       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3884 
3885       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3886         PetscInt j;
3887 
3888         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3889         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3890         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3891         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3892         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3893         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3894         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3895       }
3896       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3897     }
3898     /* if n_R == 0 the object is not destroyed */
3899     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3900   }
3901   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3902 
3903   if (n_constraints) {
3904     Mat B;
3905 
3906     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3907     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3908     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3909     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3910     if (n_vertices) {
3911       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3912         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3913       } else {
3914         Mat S_VCt;
3915 
3916         if (lda_rhs != n_R) {
3917           ierr = MatDestroy(&B);CHKERRQ(ierr);
3918           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3919           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3920         }
3921         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3922         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3923         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3924       }
3925     }
3926     ierr = MatDestroy(&B);CHKERRQ(ierr);
3927     /* coarse basis functions */
3928     for (i=0;i<n_constraints;i++) {
3929       PetscScalar *y;
3930 
3931       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3932       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3933       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3934       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3935       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3936       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3937       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3938       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3939         PetscInt j;
3940 
3941         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3942         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3943         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3944         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3945         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3946         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3947         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3948       }
3949       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3950     }
3951   }
3952   if (n_constraints) {
3953     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3954   }
3955   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3956 
3957   /* coarse matrix entries relative to B_0 */
3958   if (pcbddc->benign_n) {
3959     Mat         B0_B,B0_BPHI;
3960     IS          is_dummy;
3961     PetscScalar *data;
3962     PetscInt    j;
3963 
3964     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3965     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3966     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3967     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3968     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3969     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3970     for (j=0;j<pcbddc->benign_n;j++) {
3971       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3972       for (i=0;i<pcbddc->local_primal_size;i++) {
3973         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3974         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3975       }
3976     }
3977     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3978     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3979     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3980   }
3981 
3982   /* compute other basis functions for non-symmetric problems */
3983   if (!pcbddc->symmetric_primal) {
3984     Mat         B_V=NULL,B_C=NULL;
3985     PetscScalar *marray;
3986 
3987     if (n_constraints) {
3988       Mat S_CCT,C_CRT;
3989 
3990       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
3991       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3992       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3993       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3994       if (n_vertices) {
3995         Mat S_VCT;
3996 
3997         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3998         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3999         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4000       }
4001       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4002     } else {
4003       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4004     }
4005     if (n_vertices && n_R) {
4006       PetscScalar    *av,*marray;
4007       const PetscInt *xadj,*adjncy;
4008       PetscInt       n;
4009       PetscBool      flg_row;
4010 
4011       /* B_V = B_V - A_VR^T */
4012       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4013       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4014       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4015       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4016       for (i=0;i<n;i++) {
4017         PetscInt j;
4018         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4019       }
4020       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4021       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4022       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4023     }
4024 
4025     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4026     if (n_vertices) {
4027       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4028       for (i=0;i<n_vertices;i++) {
4029         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4030         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4031         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4032         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4033         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4034       }
4035       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4036     }
4037     if (B_C) {
4038       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4039       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4040         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4041         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4042         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4043         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4044         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4045       }
4046       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4047     }
4048     /* coarse basis functions */
4049     for (i=0;i<pcbddc->local_primal_size;i++) {
4050       PetscScalar *y;
4051 
4052       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4053       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4054       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4055       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4056       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4057       if (i<n_vertices) {
4058         y[n_B*i+idx_V_B[i]] = 1.0;
4059       }
4060       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4061       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4062 
4063       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4064         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4065         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4066         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4067         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4068         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4069         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4070       }
4071       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4072     }
4073     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4074     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4075   }
4076 
4077   /* free memory */
4078   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4079   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4080   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4081   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4082   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4083   ierr = PetscFree(work);CHKERRQ(ierr);
4084   if (n_vertices) {
4085     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4086   }
4087   if (n_constraints) {
4088     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4089   }
4090   /* Checking coarse_sub_mat and coarse basis functios */
4091   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4092   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4093   if (pcbddc->dbg_flag) {
4094     Mat         coarse_sub_mat;
4095     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4096     Mat         coarse_phi_D,coarse_phi_B;
4097     Mat         coarse_psi_D,coarse_psi_B;
4098     Mat         A_II,A_BB,A_IB,A_BI;
4099     Mat         C_B,CPHI;
4100     IS          is_dummy;
4101     Vec         mones;
4102     MatType     checkmattype=MATSEQAIJ;
4103     PetscReal   real_value;
4104 
4105     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4106       Mat A;
4107       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4108       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4109       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4110       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4111       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4112       ierr = MatDestroy(&A);CHKERRQ(ierr);
4113     } else {
4114       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4115       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4116       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4117       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4118     }
4119     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4120     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4121     if (!pcbddc->symmetric_primal) {
4122       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4123       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4124     }
4125     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4126 
4127     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4128     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4129     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4130     if (!pcbddc->symmetric_primal) {
4131       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4132       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4133       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4134       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4135       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4136       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4137       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4138       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4139       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4140       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4141       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4142       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4143     } else {
4144       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4145       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4146       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4147       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4148       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4149       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4150       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4151       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4152     }
4153     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4154     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4155     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4156     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4157     if (pcbddc->benign_n) {
4158       Mat         B0_B,B0_BPHI;
4159       PetscScalar *data,*data2;
4160       PetscInt    j;
4161 
4162       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4163       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4164       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4165       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4166       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4167       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4168       for (j=0;j<pcbddc->benign_n;j++) {
4169         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4170         for (i=0;i<pcbddc->local_primal_size;i++) {
4171           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4172           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4173         }
4174       }
4175       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4176       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4177       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4178       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4179       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4180     }
4181 #if 0
4182   {
4183     PetscViewer viewer;
4184     char filename[256];
4185     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4186     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4187     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4188     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4189     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4190     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4191     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4192     if (save_change) {
4193       Mat phi_B;
4194       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4195       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4196       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4197       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4198     } else {
4199       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4200       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4201     }
4202     if (pcbddc->coarse_phi_D) {
4203       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4204       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4205     }
4206     if (pcbddc->coarse_psi_B) {
4207       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4208       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4209     }
4210     if (pcbddc->coarse_psi_D) {
4211       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4212       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4213     }
4214     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4215   }
4216 #endif
4217     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4218     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4219     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4220     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4221 
4222     /* check constraints */
4223     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4224     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4225     if (!pcbddc->benign_n) { /* TODO: add benign case */
4226       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4227     } else {
4228       PetscScalar *data;
4229       Mat         tmat;
4230       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4231       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4232       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4233       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4234       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4235     }
4236     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4237     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4238     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4239     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4240     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4241     if (!pcbddc->symmetric_primal) {
4242       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4243       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4244       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4245       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4246       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4247     }
4248     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4249     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4250     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4251     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4252     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4253     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4254     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4255     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4256     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4257     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4258     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4259     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4260     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4261     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4262     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4263     if (!pcbddc->symmetric_primal) {
4264       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4265       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4266     }
4267     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4268   }
4269   /* get back data */
4270   *coarse_submat_vals_n = coarse_submat_vals;
4271   PetscFunctionReturn(0);
4272 }
4273 
4274 #undef __FUNCT__
4275 #define __FUNCT__ "MatGetSubMatrixUnsorted"
4276 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4277 {
4278   Mat            *work_mat;
4279   IS             isrow_s,iscol_s;
4280   PetscBool      rsorted,csorted;
4281   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4282   PetscErrorCode ierr;
4283 
4284   PetscFunctionBegin;
4285   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4286   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4287   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4288   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4289 
4290   if (!rsorted) {
4291     const PetscInt *idxs;
4292     PetscInt *idxs_sorted,i;
4293 
4294     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4295     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4296     for (i=0;i<rsize;i++) {
4297       idxs_perm_r[i] = i;
4298     }
4299     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4300     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4301     for (i=0;i<rsize;i++) {
4302       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4303     }
4304     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4305     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4306   } else {
4307     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4308     isrow_s = isrow;
4309   }
4310 
4311   if (!csorted) {
4312     if (isrow == iscol) {
4313       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4314       iscol_s = isrow_s;
4315     } else {
4316       const PetscInt *idxs;
4317       PetscInt       *idxs_sorted,i;
4318 
4319       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4320       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4321       for (i=0;i<csize;i++) {
4322         idxs_perm_c[i] = i;
4323       }
4324       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4325       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4326       for (i=0;i<csize;i++) {
4327         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4328       }
4329       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4330       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4331     }
4332   } else {
4333     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4334     iscol_s = iscol;
4335   }
4336 
4337   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4338 
4339   if (!rsorted || !csorted) {
4340     Mat      new_mat;
4341     IS       is_perm_r,is_perm_c;
4342 
4343     if (!rsorted) {
4344       PetscInt *idxs_r,i;
4345       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4346       for (i=0;i<rsize;i++) {
4347         idxs_r[idxs_perm_r[i]] = i;
4348       }
4349       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4350       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4351     } else {
4352       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4353     }
4354     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4355 
4356     if (!csorted) {
4357       if (isrow_s == iscol_s) {
4358         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4359         is_perm_c = is_perm_r;
4360       } else {
4361         PetscInt *idxs_c,i;
4362         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4363         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4364         for (i=0;i<csize;i++) {
4365           idxs_c[idxs_perm_c[i]] = i;
4366         }
4367         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4368         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4369       }
4370     } else {
4371       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4372     }
4373     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4374 
4375     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4376     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4377     work_mat[0] = new_mat;
4378     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4379     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4380   }
4381 
4382   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4383   *B = work_mat[0];
4384   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4385   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4386   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4387   PetscFunctionReturn(0);
4388 }
4389 
4390 #undef __FUNCT__
4391 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
4392 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4393 {
4394   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4395   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4396   Mat            new_mat;
4397   IS             is_local,is_global;
4398   PetscInt       local_size;
4399   PetscBool      isseqaij;
4400   PetscErrorCode ierr;
4401 
4402   PetscFunctionBegin;
4403   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4404   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4405   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4406   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4407   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4408   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4409   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4410 
4411   /* check */
4412   if (pcbddc->dbg_flag) {
4413     Vec       x,x_change;
4414     PetscReal error;
4415 
4416     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4417     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4418     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4419     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4420     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4421     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4422     if (!pcbddc->change_interior) {
4423       const PetscScalar *x,*y,*v;
4424       PetscReal         lerror = 0.;
4425       PetscInt          i;
4426 
4427       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4428       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4429       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4430       for (i=0;i<local_size;i++)
4431         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4432           lerror = PetscAbsScalar(x[i]-y[i]);
4433       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4434       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4435       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4436       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4437       if (error > PETSC_SMALL) {
4438         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4439           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4440         } else {
4441           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4442         }
4443       }
4444     }
4445     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4446     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4447     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4448     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4449     if (error > PETSC_SMALL) {
4450       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4451         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4452       } else {
4453         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4454       }
4455     }
4456     ierr = VecDestroy(&x);CHKERRQ(ierr);
4457     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4458   }
4459 
4460   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4461   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4462   if (isseqaij) {
4463     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4464     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4465   } else {
4466     Mat work_mat;
4467 
4468     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4469     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4470     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4471     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4472   }
4473   if (matis->A->symmetric_set) {
4474     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4475 #if !defined(PETSC_USE_COMPLEX)
4476     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4477 #endif
4478   }
4479   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4480   PetscFunctionReturn(0);
4481 }
4482 
4483 #undef __FUNCT__
4484 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4485 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4486 {
4487   PC_IS*          pcis = (PC_IS*)(pc->data);
4488   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4489   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4490   PetscInt        *idx_R_local=NULL;
4491   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4492   PetscInt        vbs,bs;
4493   PetscBT         bitmask=NULL;
4494   PetscErrorCode  ierr;
4495 
4496   PetscFunctionBegin;
4497   /*
4498     No need to setup local scatters if
4499       - primal space is unchanged
4500         AND
4501       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4502         AND
4503       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4504   */
4505   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4506     PetscFunctionReturn(0);
4507   }
4508   /* destroy old objects */
4509   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4510   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4511   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4512   /* Set Non-overlapping dimensions */
4513   n_B = pcis->n_B;
4514   n_D = pcis->n - n_B;
4515   n_vertices = pcbddc->n_vertices;
4516 
4517   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4518 
4519   /* create auxiliary bitmask and allocate workspace */
4520   if (!sub_schurs || !sub_schurs->reuse_solver) {
4521     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4522     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4523     for (i=0;i<n_vertices;i++) {
4524       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4525     }
4526 
4527     for (i=0, n_R=0; i<pcis->n; i++) {
4528       if (!PetscBTLookup(bitmask,i)) {
4529         idx_R_local[n_R++] = i;
4530       }
4531     }
4532   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4533     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4534 
4535     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4536     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4537   }
4538 
4539   /* Block code */
4540   vbs = 1;
4541   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4542   if (bs>1 && !(n_vertices%bs)) {
4543     PetscBool is_blocked = PETSC_TRUE;
4544     PetscInt  *vary;
4545     if (!sub_schurs || !sub_schurs->reuse_solver) {
4546       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4547       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4548       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4549       /* 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 */
4550       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4551       for (i=0; i<pcis->n/bs; i++) {
4552         if (vary[i]!=0 && vary[i]!=bs) {
4553           is_blocked = PETSC_FALSE;
4554           break;
4555         }
4556       }
4557       ierr = PetscFree(vary);CHKERRQ(ierr);
4558     } else {
4559       /* Verify directly the R set */
4560       for (i=0; i<n_R/bs; i++) {
4561         PetscInt j,node=idx_R_local[bs*i];
4562         for (j=1; j<bs; j++) {
4563           if (node != idx_R_local[bs*i+j]-j) {
4564             is_blocked = PETSC_FALSE;
4565             break;
4566           }
4567         }
4568       }
4569     }
4570     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4571       vbs = bs;
4572       for (i=0;i<n_R/vbs;i++) {
4573         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4574       }
4575     }
4576   }
4577   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4578   if (sub_schurs && sub_schurs->reuse_solver) {
4579     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4580 
4581     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4582     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4583     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4584     reuse_solver->is_R = pcbddc->is_R_local;
4585   } else {
4586     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4587   }
4588 
4589   /* print some info if requested */
4590   if (pcbddc->dbg_flag) {
4591     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4592     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4593     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4594     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4595     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4596     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);
4597     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4598   }
4599 
4600   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4601   if (!sub_schurs || !sub_schurs->reuse_solver) {
4602     IS       is_aux1,is_aux2;
4603     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4604 
4605     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4606     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4607     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4608     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4609     for (i=0; i<n_D; i++) {
4610       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4611     }
4612     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4613     for (i=0, j=0; i<n_R; i++) {
4614       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4615         aux_array1[j++] = i;
4616       }
4617     }
4618     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4619     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4620     for (i=0, j=0; i<n_B; i++) {
4621       if (!PetscBTLookup(bitmask,is_indices[i])) {
4622         aux_array2[j++] = i;
4623       }
4624     }
4625     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4626     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4627     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4628     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4629     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4630 
4631     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4632       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4633       for (i=0, j=0; i<n_R; i++) {
4634         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4635           aux_array1[j++] = i;
4636         }
4637       }
4638       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4639       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4640       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4641     }
4642     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4643     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4644   } else {
4645     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4646     IS                 tis;
4647     PetscInt           schur_size;
4648 
4649     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4650     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4651     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4652     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4653     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4654       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4655       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4656       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4657     }
4658   }
4659   PetscFunctionReturn(0);
4660 }
4661 
4662 
4663 #undef __FUNCT__
4664 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4665 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4666 {
4667   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4668   PC_IS          *pcis = (PC_IS*)pc->data;
4669   PC             pc_temp;
4670   Mat            A_RR;
4671   MatReuse       reuse;
4672   PetscScalar    m_one = -1.0;
4673   PetscReal      value;
4674   PetscInt       n_D,n_R;
4675   PetscBool      check_corr[2],issbaij;
4676   PetscErrorCode ierr;
4677   /* prefixes stuff */
4678   char           dir_prefix[256],neu_prefix[256],str_level[16];
4679   size_t         len;
4680 
4681   PetscFunctionBegin;
4682 
4683   /* compute prefixes */
4684   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4685   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4686   if (!pcbddc->current_level) {
4687     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4688     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4689     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4690     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4691   } else {
4692     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4693     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4694     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4695     len -= 15; /* remove "pc_bddc_coarse_" */
4696     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4697     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4698     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4699     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4700     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4701     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4702     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4703     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4704   }
4705 
4706   /* DIRICHLET PROBLEM */
4707   if (dirichlet) {
4708     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4709     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4710       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4711       if (pcbddc->dbg_flag) {
4712         Mat    A_IIn;
4713 
4714         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4715         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4716         pcis->A_II = A_IIn;
4717       }
4718     }
4719     if (pcbddc->local_mat->symmetric_set) {
4720       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4721     }
4722     /* Matrix for Dirichlet problem is pcis->A_II */
4723     n_D = pcis->n - pcis->n_B;
4724     if (!pcbddc->ksp_D) { /* create object if not yet build */
4725       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4726       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4727       /* default */
4728       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4729       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4730       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4731       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4732       if (issbaij) {
4733         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4734       } else {
4735         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4736       }
4737       /* Allow user's customization */
4738       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4739       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4740     }
4741     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4742     if (sub_schurs && sub_schurs->reuse_solver) {
4743       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4744 
4745       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4746     }
4747     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4748     if (!n_D) {
4749       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4750       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4751     }
4752     /* Set Up KSP for Dirichlet problem of BDDC */
4753     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4754     /* set ksp_D into pcis data */
4755     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4756     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4757     pcis->ksp_D = pcbddc->ksp_D;
4758   }
4759 
4760   /* NEUMANN PROBLEM */
4761   A_RR = 0;
4762   if (neumann) {
4763     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4764     PetscInt        ibs,mbs;
4765     PetscBool       issbaij;
4766     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4767     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4768     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4769     if (pcbddc->ksp_R) { /* already created ksp */
4770       PetscInt nn_R;
4771       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4772       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4773       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4774       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4775         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4776         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4777         reuse = MAT_INITIAL_MATRIX;
4778       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4779         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4780           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4781           reuse = MAT_INITIAL_MATRIX;
4782         } else { /* safe to reuse the matrix */
4783           reuse = MAT_REUSE_MATRIX;
4784         }
4785       }
4786       /* last check */
4787       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4788         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4789         reuse = MAT_INITIAL_MATRIX;
4790       }
4791     } else { /* first time, so we need to create the matrix */
4792       reuse = MAT_INITIAL_MATRIX;
4793     }
4794     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4795     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4796     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4797     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4798     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4799       if (matis->A == pcbddc->local_mat) {
4800         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4801         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4802       } else {
4803         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4804       }
4805     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4806       if (matis->A == pcbddc->local_mat) {
4807         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4808         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4809       } else {
4810         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4811       }
4812     }
4813     /* extract A_RR */
4814     if (sub_schurs && sub_schurs->reuse_solver) {
4815       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4816 
4817       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4818         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4819         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4820           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4821         } else {
4822           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4823         }
4824       } else {
4825         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4826         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4827         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4828       }
4829     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4830       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4831     }
4832     if (pcbddc->local_mat->symmetric_set) {
4833       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4834     }
4835     if (!pcbddc->ksp_R) { /* create object if not present */
4836       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4837       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4838       /* default */
4839       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4840       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4841       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4842       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4843       if (issbaij) {
4844         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4845       } else {
4846         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4847       }
4848       /* Allow user's customization */
4849       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4850       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4851     }
4852     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4853     if (!n_R) {
4854       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4855       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4856     }
4857     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4858     /* Reuse solver if it is present */
4859     if (sub_schurs && sub_schurs->reuse_solver) {
4860       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4861 
4862       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4863     }
4864     /* Set Up KSP for Neumann problem of BDDC */
4865     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4866   }
4867 
4868   if (pcbddc->dbg_flag) {
4869     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4870     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4871     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4872   }
4873 
4874   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4875   check_corr[0] = check_corr[1] = PETSC_FALSE;
4876   if (pcbddc->NullSpace_corr[0]) {
4877     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4878   }
4879   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4880     check_corr[0] = PETSC_TRUE;
4881     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4882   }
4883   if (neumann && pcbddc->NullSpace_corr[2]) {
4884     check_corr[1] = PETSC_TRUE;
4885     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4886   }
4887 
4888   /* check Dirichlet and Neumann solvers */
4889   if (pcbddc->dbg_flag) {
4890     if (dirichlet) { /* Dirichlet */
4891       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4892       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4893       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4894       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4895       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4896       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);
4897       if (check_corr[0]) {
4898         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4899       }
4900       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4901     }
4902     if (neumann) { /* Neumann */
4903       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4904       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4905       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4906       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4907       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4908       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);
4909       if (check_corr[1]) {
4910         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4911       }
4912       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4913     }
4914   }
4915   /* free Neumann problem's matrix */
4916   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4917   PetscFunctionReturn(0);
4918 }
4919 
4920 #undef __FUNCT__
4921 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4922 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4923 {
4924   PetscErrorCode  ierr;
4925   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4926   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4927   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4928 
4929   PetscFunctionBegin;
4930   if (!reuse_solver) {
4931     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4932   }
4933   if (!pcbddc->switch_static) {
4934     if (applytranspose && pcbddc->local_auxmat1) {
4935       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4936       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4937     }
4938     if (!reuse_solver) {
4939       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4940       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4941     } else {
4942       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4943 
4944       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4945       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4946     }
4947   } else {
4948     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4949     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4950     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4951     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4952     if (applytranspose && pcbddc->local_auxmat1) {
4953       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4954       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4955       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4956       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4957     }
4958   }
4959   if (!reuse_solver || pcbddc->switch_static) {
4960     if (applytranspose) {
4961       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4962     } else {
4963       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4964     }
4965   } else {
4966     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4967 
4968     if (applytranspose) {
4969       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4970     } else {
4971       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4972     }
4973   }
4974   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4975   if (!pcbddc->switch_static) {
4976     if (!reuse_solver) {
4977       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4978       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4979     } else {
4980       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4981 
4982       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4983       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4984     }
4985     if (!applytranspose && pcbddc->local_auxmat1) {
4986       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4987       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4988     }
4989   } else {
4990     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4991     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4992     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4993     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4994     if (!applytranspose && pcbddc->local_auxmat1) {
4995       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4996       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4997     }
4998     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4999     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5000     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5001     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5002   }
5003   PetscFunctionReturn(0);
5004 }
5005 
5006 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5007 #undef __FUNCT__
5008 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
5009 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5010 {
5011   PetscErrorCode ierr;
5012   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5013   PC_IS*            pcis = (PC_IS*)  (pc->data);
5014   const PetscScalar zero = 0.0;
5015 
5016   PetscFunctionBegin;
5017   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5018   if (!pcbddc->benign_apply_coarse_only) {
5019     if (applytranspose) {
5020       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5021       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5022     } else {
5023       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5024       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5025     }
5026   } else {
5027     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5028   }
5029 
5030   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5031   if (pcbddc->benign_n) {
5032     PetscScalar *array;
5033     PetscInt    j;
5034 
5035     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5036     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5037     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5038   }
5039 
5040   /* start communications from local primal nodes to rhs of coarse solver */
5041   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5042   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5043   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5044 
5045   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5046   if (pcbddc->coarse_ksp) {
5047     Mat          coarse_mat;
5048     Vec          rhs,sol;
5049     MatNullSpace nullsp;
5050     PetscBool    isbddc = PETSC_FALSE;
5051 
5052     if (pcbddc->benign_have_null) {
5053       PC        coarse_pc;
5054 
5055       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5056       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5057       /* we need to propagate to coarser levels the need for a possible benign correction */
5058       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5059         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5060         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5061         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5062       }
5063     }
5064     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5065     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5066     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5067     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5068     if (nullsp) {
5069       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5070     }
5071     if (applytranspose) {
5072       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5073       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5074     } else {
5075       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5076         PC        coarse_pc;
5077 
5078         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5079         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5080         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5081         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5082       } else {
5083         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5084       }
5085     }
5086     /* we don't need the benign correction at coarser levels anymore */
5087     if (pcbddc->benign_have_null && isbddc) {
5088       PC        coarse_pc;
5089       PC_BDDC*  coarsepcbddc;
5090 
5091       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5092       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5093       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5094       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5095     }
5096     if (nullsp) {
5097       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5098     }
5099   }
5100 
5101   /* Local solution on R nodes */
5102   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5103     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5104   }
5105   /* communications from coarse sol to local primal nodes */
5106   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5107   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5108 
5109   /* Sum contributions from the two levels */
5110   if (!pcbddc->benign_apply_coarse_only) {
5111     if (applytranspose) {
5112       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5113       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5114     } else {
5115       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5116       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5117     }
5118     /* store p0 */
5119     if (pcbddc->benign_n) {
5120       PetscScalar *array;
5121       PetscInt    j;
5122 
5123       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5124       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5125       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5126     }
5127   } else { /* expand the coarse solution */
5128     if (applytranspose) {
5129       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5130     } else {
5131       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5132     }
5133   }
5134   PetscFunctionReturn(0);
5135 }
5136 
5137 #undef __FUNCT__
5138 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5139 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5140 {
5141   PetscErrorCode ierr;
5142   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5143   PetscScalar    *array;
5144   Vec            from,to;
5145 
5146   PetscFunctionBegin;
5147   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5148     from = pcbddc->coarse_vec;
5149     to = pcbddc->vec1_P;
5150     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5151       Vec tvec;
5152 
5153       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5154       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5155       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5156       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5157       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5158       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5159     }
5160   } else { /* from local to global -> put data in coarse right hand side */
5161     from = pcbddc->vec1_P;
5162     to = pcbddc->coarse_vec;
5163   }
5164   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5165   PetscFunctionReturn(0);
5166 }
5167 
5168 #undef __FUNCT__
5169 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5170 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5171 {
5172   PetscErrorCode ierr;
5173   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5174   PetscScalar    *array;
5175   Vec            from,to;
5176 
5177   PetscFunctionBegin;
5178   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5179     from = pcbddc->coarse_vec;
5180     to = pcbddc->vec1_P;
5181   } else { /* from local to global -> put data in coarse right hand side */
5182     from = pcbddc->vec1_P;
5183     to = pcbddc->coarse_vec;
5184   }
5185   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5186   if (smode == SCATTER_FORWARD) {
5187     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5188       Vec tvec;
5189 
5190       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5191       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5192       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5193       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5194     }
5195   } else {
5196     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5197      ierr = VecResetArray(from);CHKERRQ(ierr);
5198     }
5199   }
5200   PetscFunctionReturn(0);
5201 }
5202 
5203 /* uncomment for testing purposes */
5204 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5205 #undef __FUNCT__
5206 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5207 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5208 {
5209   PetscErrorCode    ierr;
5210   PC_IS*            pcis = (PC_IS*)(pc->data);
5211   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5212   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5213   /* one and zero */
5214   PetscScalar       one=1.0,zero=0.0;
5215   /* space to store constraints and their local indices */
5216   PetscScalar       *constraints_data;
5217   PetscInt          *constraints_idxs,*constraints_idxs_B;
5218   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5219   PetscInt          *constraints_n;
5220   /* iterators */
5221   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5222   /* BLAS integers */
5223   PetscBLASInt      lwork,lierr;
5224   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5225   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5226   /* reuse */
5227   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5228   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5229   /* change of basis */
5230   PetscBool         qr_needed;
5231   PetscBT           change_basis,qr_needed_idx;
5232   /* auxiliary stuff */
5233   PetscInt          *nnz,*is_indices;
5234   PetscInt          ncc;
5235   /* some quantities */
5236   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5237   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5238 
5239   PetscFunctionBegin;
5240   /* Destroy Mat objects computed previously */
5241   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5242   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5243   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5244   /* save info on constraints from previous setup (if any) */
5245   olocal_primal_size = pcbddc->local_primal_size;
5246   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5247   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5248   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5249   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5250   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5251   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5252 
5253   if (!pcbddc->adaptive_selection) {
5254     IS           ISForVertices,*ISForFaces,*ISForEdges;
5255     MatNullSpace nearnullsp;
5256     const Vec    *nearnullvecs;
5257     Vec          *localnearnullsp;
5258     PetscScalar  *array;
5259     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5260     PetscBool    nnsp_has_cnst;
5261     /* LAPACK working arrays for SVD or POD */
5262     PetscBool    skip_lapack,boolforchange;
5263     PetscScalar  *work;
5264     PetscReal    *singular_vals;
5265 #if defined(PETSC_USE_COMPLEX)
5266     PetscReal    *rwork;
5267 #endif
5268 #if defined(PETSC_MISSING_LAPACK_GESVD)
5269     PetscScalar  *temp_basis,*correlation_mat;
5270 #else
5271     PetscBLASInt dummy_int=1;
5272     PetscScalar  dummy_scalar=1.;
5273 #endif
5274 
5275     /* Get index sets for faces, edges and vertices from graph */
5276     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5277     /* print some info */
5278     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5279       PetscInt nv;
5280 
5281       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5282       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5283       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5284       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5285       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5286       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5287       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5288       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5289       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5290     }
5291 
5292     /* free unneeded index sets */
5293     if (!pcbddc->use_vertices) {
5294       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5295     }
5296     if (!pcbddc->use_edges) {
5297       for (i=0;i<n_ISForEdges;i++) {
5298         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5299       }
5300       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5301       n_ISForEdges = 0;
5302     }
5303     if (!pcbddc->use_faces) {
5304       for (i=0;i<n_ISForFaces;i++) {
5305         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5306       }
5307       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5308       n_ISForFaces = 0;
5309     }
5310 
5311     /* check if near null space is attached to global mat */
5312     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5313     if (nearnullsp) {
5314       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5315       /* remove any stored info */
5316       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5317       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5318       /* store information for BDDC solver reuse */
5319       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5320       pcbddc->onearnullspace = nearnullsp;
5321       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5322       for (i=0;i<nnsp_size;i++) {
5323         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5324       }
5325     } else { /* if near null space is not provided BDDC uses constants by default */
5326       nnsp_size = 0;
5327       nnsp_has_cnst = PETSC_TRUE;
5328     }
5329     /* get max number of constraints on a single cc */
5330     max_constraints = nnsp_size;
5331     if (nnsp_has_cnst) max_constraints++;
5332 
5333     /*
5334          Evaluate maximum storage size needed by the procedure
5335          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5336          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5337          There can be multiple constraints per connected component
5338                                                                                                                                                            */
5339     n_vertices = 0;
5340     if (ISForVertices) {
5341       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5342     }
5343     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5344     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5345 
5346     total_counts = n_ISForFaces+n_ISForEdges;
5347     total_counts *= max_constraints;
5348     total_counts += n_vertices;
5349     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5350 
5351     total_counts = 0;
5352     max_size_of_constraint = 0;
5353     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5354       IS used_is;
5355       if (i<n_ISForEdges) {
5356         used_is = ISForEdges[i];
5357       } else {
5358         used_is = ISForFaces[i-n_ISForEdges];
5359       }
5360       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5361       total_counts += j;
5362       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5363     }
5364     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);
5365 
5366     /* get local part of global near null space vectors */
5367     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5368     for (k=0;k<nnsp_size;k++) {
5369       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5370       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5371       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5372     }
5373 
5374     /* whether or not to skip lapack calls */
5375     skip_lapack = PETSC_TRUE;
5376     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5377 
5378     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5379     if (!skip_lapack) {
5380       PetscScalar temp_work;
5381 
5382 #if defined(PETSC_MISSING_LAPACK_GESVD)
5383       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5384       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5385       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5386       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5387 #if defined(PETSC_USE_COMPLEX)
5388       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5389 #endif
5390       /* now we evaluate the optimal workspace using query with lwork=-1 */
5391       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5392       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5393       lwork = -1;
5394       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5395 #if !defined(PETSC_USE_COMPLEX)
5396       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5397 #else
5398       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5399 #endif
5400       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5401       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5402 #else /* on missing GESVD */
5403       /* SVD */
5404       PetscInt max_n,min_n;
5405       max_n = max_size_of_constraint;
5406       min_n = max_constraints;
5407       if (max_size_of_constraint < max_constraints) {
5408         min_n = max_size_of_constraint;
5409         max_n = max_constraints;
5410       }
5411       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5412 #if defined(PETSC_USE_COMPLEX)
5413       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5414 #endif
5415       /* now we evaluate the optimal workspace using query with lwork=-1 */
5416       lwork = -1;
5417       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5418       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5419       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5420       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5421 #if !defined(PETSC_USE_COMPLEX)
5422       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));
5423 #else
5424       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));
5425 #endif
5426       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5427       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5428 #endif /* on missing GESVD */
5429       /* Allocate optimal workspace */
5430       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5431       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5432     }
5433     /* Now we can loop on constraining sets */
5434     total_counts = 0;
5435     constraints_idxs_ptr[0] = 0;
5436     constraints_data_ptr[0] = 0;
5437     /* vertices */
5438     if (n_vertices) {
5439       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5440       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5441       for (i=0;i<n_vertices;i++) {
5442         constraints_n[total_counts] = 1;
5443         constraints_data[total_counts] = 1.0;
5444         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5445         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5446         total_counts++;
5447       }
5448       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5449       n_vertices = total_counts;
5450     }
5451 
5452     /* edges and faces */
5453     total_counts_cc = total_counts;
5454     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5455       IS        used_is;
5456       PetscBool idxs_copied = PETSC_FALSE;
5457 
5458       if (ncc<n_ISForEdges) {
5459         used_is = ISForEdges[ncc];
5460         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5461       } else {
5462         used_is = ISForFaces[ncc-n_ISForEdges];
5463         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5464       }
5465       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5466 
5467       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5468       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5469       /* change of basis should not be performed on local periodic nodes */
5470       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5471       if (nnsp_has_cnst) {
5472         PetscScalar quad_value;
5473 
5474         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5475         idxs_copied = PETSC_TRUE;
5476 
5477         if (!pcbddc->use_nnsp_true) {
5478           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5479         } else {
5480           quad_value = 1.0;
5481         }
5482         for (j=0;j<size_of_constraint;j++) {
5483           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5484         }
5485         temp_constraints++;
5486         total_counts++;
5487       }
5488       for (k=0;k<nnsp_size;k++) {
5489         PetscReal real_value;
5490         PetscScalar *ptr_to_data;
5491 
5492         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5493         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5494         for (j=0;j<size_of_constraint;j++) {
5495           ptr_to_data[j] = array[is_indices[j]];
5496         }
5497         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5498         /* check if array is null on the connected component */
5499         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5500         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5501         if (real_value > 0.0) { /* keep indices and values */
5502           temp_constraints++;
5503           total_counts++;
5504           if (!idxs_copied) {
5505             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5506             idxs_copied = PETSC_TRUE;
5507           }
5508         }
5509       }
5510       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5511       valid_constraints = temp_constraints;
5512       if (!pcbddc->use_nnsp_true && temp_constraints) {
5513         if (temp_constraints == 1) { /* just normalize the constraint */
5514           PetscScalar norm,*ptr_to_data;
5515 
5516           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5517           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5518           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5519           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5520           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5521         } else { /* perform SVD */
5522           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5523           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5524 
5525 #if defined(PETSC_MISSING_LAPACK_GESVD)
5526           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5527              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5528              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5529                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5530                 from that computed using LAPACKgesvd
5531              -> This is due to a different computation of eigenvectors in LAPACKheev
5532              -> The quality of the POD-computed basis will be the same */
5533           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5534           /* Store upper triangular part of correlation matrix */
5535           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5536           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5537           for (j=0;j<temp_constraints;j++) {
5538             for (k=0;k<j+1;k++) {
5539               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));
5540             }
5541           }
5542           /* compute eigenvalues and eigenvectors of correlation matrix */
5543           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5544           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5545 #if !defined(PETSC_USE_COMPLEX)
5546           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5547 #else
5548           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5549 #endif
5550           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5551           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5552           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5553           j = 0;
5554           while (j < temp_constraints && singular_vals[j] < tol) j++;
5555           total_counts = total_counts-j;
5556           valid_constraints = temp_constraints-j;
5557           /* scale and copy POD basis into used quadrature memory */
5558           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5559           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5560           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5561           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5562           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5563           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5564           if (j<temp_constraints) {
5565             PetscInt ii;
5566             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5567             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5568             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));
5569             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5570             for (k=0;k<temp_constraints-j;k++) {
5571               for (ii=0;ii<size_of_constraint;ii++) {
5572                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5573               }
5574             }
5575           }
5576 #else  /* on missing GESVD */
5577           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5578           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5579           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5580           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5581 #if !defined(PETSC_USE_COMPLEX)
5582           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));
5583 #else
5584           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));
5585 #endif
5586           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5587           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5588           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5589           k = temp_constraints;
5590           if (k > size_of_constraint) k = size_of_constraint;
5591           j = 0;
5592           while (j < k && singular_vals[k-j-1] < tol) j++;
5593           valid_constraints = k-j;
5594           total_counts = total_counts-temp_constraints+valid_constraints;
5595 #endif /* on missing GESVD */
5596         }
5597       }
5598       /* update pointers information */
5599       if (valid_constraints) {
5600         constraints_n[total_counts_cc] = valid_constraints;
5601         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5602         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5603         /* set change_of_basis flag */
5604         if (boolforchange) {
5605           PetscBTSet(change_basis,total_counts_cc);
5606         }
5607         total_counts_cc++;
5608       }
5609     }
5610     /* free workspace */
5611     if (!skip_lapack) {
5612       ierr = PetscFree(work);CHKERRQ(ierr);
5613 #if defined(PETSC_USE_COMPLEX)
5614       ierr = PetscFree(rwork);CHKERRQ(ierr);
5615 #endif
5616       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5617 #if defined(PETSC_MISSING_LAPACK_GESVD)
5618       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5619       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5620 #endif
5621     }
5622     for (k=0;k<nnsp_size;k++) {
5623       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5624     }
5625     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5626     /* free index sets of faces, edges and vertices */
5627     for (i=0;i<n_ISForFaces;i++) {
5628       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5629     }
5630     if (n_ISForFaces) {
5631       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5632     }
5633     for (i=0;i<n_ISForEdges;i++) {
5634       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5635     }
5636     if (n_ISForEdges) {
5637       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5638     }
5639     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5640   } else {
5641     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5642 
5643     total_counts = 0;
5644     n_vertices = 0;
5645     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5646       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5647     }
5648     max_constraints = 0;
5649     total_counts_cc = 0;
5650     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5651       total_counts += pcbddc->adaptive_constraints_n[i];
5652       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5653       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5654     }
5655     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5656     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5657     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5658     constraints_data = pcbddc->adaptive_constraints_data;
5659     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5660     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5661     total_counts_cc = 0;
5662     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5663       if (pcbddc->adaptive_constraints_n[i]) {
5664         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5665       }
5666     }
5667 #if 0
5668     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5669     for (i=0;i<total_counts_cc;i++) {
5670       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5671       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5672       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5673         printf(" %d",constraints_idxs[j]);
5674       }
5675       printf("\n");
5676       printf("number of cc: %d\n",constraints_n[i]);
5677     }
5678     for (i=0;i<n_vertices;i++) {
5679       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5680     }
5681     for (i=0;i<sub_schurs->n_subs;i++) {
5682       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]);
5683     }
5684 #endif
5685 
5686     max_size_of_constraint = 0;
5687     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]);
5688     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5689     /* Change of basis */
5690     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5691     if (pcbddc->use_change_of_basis) {
5692       for (i=0;i<sub_schurs->n_subs;i++) {
5693         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5694           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5695         }
5696       }
5697     }
5698   }
5699   pcbddc->local_primal_size = total_counts;
5700   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5701 
5702   /* map constraints_idxs in boundary numbering */
5703   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5704   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);
5705 
5706   /* Create constraint matrix */
5707   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5708   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5709   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5710 
5711   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5712   /* determine if a QR strategy is needed for change of basis */
5713   qr_needed = PETSC_FALSE;
5714   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5715   total_primal_vertices=0;
5716   pcbddc->local_primal_size_cc = 0;
5717   for (i=0;i<total_counts_cc;i++) {
5718     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5719     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5720       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5721       pcbddc->local_primal_size_cc += 1;
5722     } else if (PetscBTLookup(change_basis,i)) {
5723       for (k=0;k<constraints_n[i];k++) {
5724         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5725       }
5726       pcbddc->local_primal_size_cc += constraints_n[i];
5727       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5728         PetscBTSet(qr_needed_idx,i);
5729         qr_needed = PETSC_TRUE;
5730       }
5731     } else {
5732       pcbddc->local_primal_size_cc += 1;
5733     }
5734   }
5735   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5736   pcbddc->n_vertices = total_primal_vertices;
5737   /* permute indices in order to have a sorted set of vertices */
5738   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5739   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);
5740   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5741   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5742 
5743   /* nonzero structure of constraint matrix */
5744   /* and get reference dof for local constraints */
5745   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5746   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5747 
5748   j = total_primal_vertices;
5749   total_counts = total_primal_vertices;
5750   cum = total_primal_vertices;
5751   for (i=n_vertices;i<total_counts_cc;i++) {
5752     if (!PetscBTLookup(change_basis,i)) {
5753       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5754       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5755       cum++;
5756       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5757       for (k=0;k<constraints_n[i];k++) {
5758         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5759         nnz[j+k] = size_of_constraint;
5760       }
5761       j += constraints_n[i];
5762     }
5763   }
5764   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5765   ierr = PetscFree(nnz);CHKERRQ(ierr);
5766 
5767   /* set values in constraint matrix */
5768   for (i=0;i<total_primal_vertices;i++) {
5769     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5770   }
5771   total_counts = total_primal_vertices;
5772   for (i=n_vertices;i<total_counts_cc;i++) {
5773     if (!PetscBTLookup(change_basis,i)) {
5774       PetscInt *cols;
5775 
5776       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5777       cols = constraints_idxs+constraints_idxs_ptr[i];
5778       for (k=0;k<constraints_n[i];k++) {
5779         PetscInt    row = total_counts+k;
5780         PetscScalar *vals;
5781 
5782         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5783         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5784       }
5785       total_counts += constraints_n[i];
5786     }
5787   }
5788   /* assembling */
5789   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5790   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5791 
5792   /*
5793   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5794   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5795   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5796   */
5797   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5798   if (pcbddc->use_change_of_basis) {
5799     /* dual and primal dofs on a single cc */
5800     PetscInt     dual_dofs,primal_dofs;
5801     /* working stuff for GEQRF */
5802     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5803     PetscBLASInt lqr_work;
5804     /* working stuff for UNGQR */
5805     PetscScalar  *gqr_work,lgqr_work_t;
5806     PetscBLASInt lgqr_work;
5807     /* working stuff for TRTRS */
5808     PetscScalar  *trs_rhs;
5809     PetscBLASInt Blas_NRHS;
5810     /* pointers for values insertion into change of basis matrix */
5811     PetscInt     *start_rows,*start_cols;
5812     PetscScalar  *start_vals;
5813     /* working stuff for values insertion */
5814     PetscBT      is_primal;
5815     PetscInt     *aux_primal_numbering_B;
5816     /* matrix sizes */
5817     PetscInt     global_size,local_size;
5818     /* temporary change of basis */
5819     Mat          localChangeOfBasisMatrix;
5820     /* extra space for debugging */
5821     PetscScalar  *dbg_work;
5822 
5823     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5824     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5825     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5826     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5827     /* nonzeros for local mat */
5828     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5829     if (!pcbddc->benign_change || pcbddc->fake_change) {
5830       for (i=0;i<pcis->n;i++) nnz[i]=1;
5831     } else {
5832       const PetscInt *ii;
5833       PetscInt       n;
5834       PetscBool      flg_row;
5835       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5836       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5837       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5838     }
5839     for (i=n_vertices;i<total_counts_cc;i++) {
5840       if (PetscBTLookup(change_basis,i)) {
5841         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5842         if (PetscBTLookup(qr_needed_idx,i)) {
5843           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5844         } else {
5845           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5846           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5847         }
5848       }
5849     }
5850     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5851     ierr = PetscFree(nnz);CHKERRQ(ierr);
5852     /* Set interior change in the matrix */
5853     if (!pcbddc->benign_change || pcbddc->fake_change) {
5854       for (i=0;i<pcis->n;i++) {
5855         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5856       }
5857     } else {
5858       const PetscInt *ii,*jj;
5859       PetscScalar    *aa;
5860       PetscInt       n;
5861       PetscBool      flg_row;
5862       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5863       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5864       for (i=0;i<n;i++) {
5865         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5866       }
5867       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5868       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5869     }
5870 
5871     if (pcbddc->dbg_flag) {
5872       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5873       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5874     }
5875 
5876 
5877     /* Now we loop on the constraints which need a change of basis */
5878     /*
5879        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5880        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5881 
5882        Basic blocks of change of basis matrix T computed by
5883 
5884           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5885 
5886             | 1        0   ...        0         s_1/S |
5887             | 0        1   ...        0         s_2/S |
5888             |              ...                        |
5889             | 0        ...            1     s_{n-1}/S |
5890             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5891 
5892             with S = \sum_{i=1}^n s_i^2
5893             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5894                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5895 
5896           - QR decomposition of constraints otherwise
5897     */
5898     if (qr_needed) {
5899       /* space to store Q */
5900       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5901       /* array to store scaling factors for reflectors */
5902       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5903       /* first we issue queries for optimal work */
5904       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5905       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5906       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5907       lqr_work = -1;
5908       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5909       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5910       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5911       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5912       lgqr_work = -1;
5913       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5914       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5915       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5916       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5917       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5918       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5919       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5920       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5921       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5922       /* array to store rhs and solution of triangular solver */
5923       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5924       /* allocating workspace for check */
5925       if (pcbddc->dbg_flag) {
5926         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5927       }
5928     }
5929     /* array to store whether a node is primal or not */
5930     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5931     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5932     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5933     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);
5934     for (i=0;i<total_primal_vertices;i++) {
5935       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5936     }
5937     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5938 
5939     /* loop on constraints and see whether or not they need a change of basis and compute it */
5940     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5941       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5942       if (PetscBTLookup(change_basis,total_counts)) {
5943         /* get constraint info */
5944         primal_dofs = constraints_n[total_counts];
5945         dual_dofs = size_of_constraint-primal_dofs;
5946 
5947         if (pcbddc->dbg_flag) {
5948           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);
5949         }
5950 
5951         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5952 
5953           /* copy quadrature constraints for change of basis check */
5954           if (pcbddc->dbg_flag) {
5955             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5956           }
5957           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5958           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5959 
5960           /* compute QR decomposition of constraints */
5961           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5962           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5963           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5964           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5965           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5966           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5967           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5968 
5969           /* explictly compute R^-T */
5970           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5971           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5972           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5973           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5974           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5975           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5976           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5977           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5978           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5979           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5980 
5981           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5982           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5983           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5984           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5985           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5986           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5987           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5988           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5989           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5990 
5991           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5992              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5993              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5994           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5995           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5996           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5997           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5998           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5999           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6000           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6001           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));
6002           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6003           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6004 
6005           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6006           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6007           /* insert cols for primal dofs */
6008           for (j=0;j<primal_dofs;j++) {
6009             start_vals = &qr_basis[j*size_of_constraint];
6010             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6011             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6012           }
6013           /* insert cols for dual dofs */
6014           for (j=0,k=0;j<dual_dofs;k++) {
6015             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6016               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6017               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6018               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6019               j++;
6020             }
6021           }
6022 
6023           /* check change of basis */
6024           if (pcbddc->dbg_flag) {
6025             PetscInt   ii,jj;
6026             PetscBool valid_qr=PETSC_TRUE;
6027             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6028             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6029             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6030             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6031             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6032             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6033             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6034             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));
6035             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6036             for (jj=0;jj<size_of_constraint;jj++) {
6037               for (ii=0;ii<primal_dofs;ii++) {
6038                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6039                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6040               }
6041             }
6042             if (!valid_qr) {
6043               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6044               for (jj=0;jj<size_of_constraint;jj++) {
6045                 for (ii=0;ii<primal_dofs;ii++) {
6046                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6047                     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]));
6048                   }
6049                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6050                     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]));
6051                   }
6052                 }
6053               }
6054             } else {
6055               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6056             }
6057           }
6058         } else { /* simple transformation block */
6059           PetscInt    row,col;
6060           PetscScalar val,norm;
6061 
6062           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6063           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6064           for (j=0;j<size_of_constraint;j++) {
6065             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6066             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6067             if (!PetscBTLookup(is_primal,row_B)) {
6068               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6069               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6070               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6071             } else {
6072               for (k=0;k<size_of_constraint;k++) {
6073                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6074                 if (row != col) {
6075                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6076                 } else {
6077                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6078                 }
6079                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6080               }
6081             }
6082           }
6083           if (pcbddc->dbg_flag) {
6084             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6085           }
6086         }
6087       } else {
6088         if (pcbddc->dbg_flag) {
6089           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6090         }
6091       }
6092     }
6093 
6094     /* free workspace */
6095     if (qr_needed) {
6096       if (pcbddc->dbg_flag) {
6097         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6098       }
6099       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6100       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6101       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6102       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6103       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6104     }
6105     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6106     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6107     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6108 
6109     /* assembling of global change of variable */
6110     if (!pcbddc->fake_change) {
6111       Mat      tmat;
6112       PetscInt bs;
6113 
6114       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6115       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6116       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6117       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6118       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6119       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6120       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6121       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6122       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6123       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6124       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6125       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6126       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6127       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6128       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6129       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6130       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6131       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6132 
6133       /* check */
6134       if (pcbddc->dbg_flag) {
6135         PetscReal error;
6136         Vec       x,x_change;
6137 
6138         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6139         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6140         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6141         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6142         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6143         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6144         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6145         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6146         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6147         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6148         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6149         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6150         if (error > PETSC_SMALL) {
6151           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6152         }
6153         ierr = VecDestroy(&x);CHKERRQ(ierr);
6154         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6155       }
6156       /* adapt sub_schurs computed (if any) */
6157       if (pcbddc->use_deluxe_scaling) {
6158         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6159 
6160         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);
6161         if (sub_schurs && sub_schurs->S_Ej_all) {
6162           Mat                    S_new,tmat;
6163           IS                     is_all_N,is_V_Sall = NULL;
6164 
6165           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6166           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6167           if (pcbddc->deluxe_zerorows) {
6168             ISLocalToGlobalMapping NtoSall;
6169             IS                     is_V;
6170             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6171             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6172             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6173             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6174             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6175           }
6176           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6177           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6178           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6179           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6180           if (pcbddc->deluxe_zerorows) {
6181             const PetscScalar *array;
6182             const PetscInt    *idxs_V,*idxs_all;
6183             PetscInt          i,n_V;
6184 
6185             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6186             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6187             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6188             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6189             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6190             for (i=0;i<n_V;i++) {
6191               PetscScalar val;
6192               PetscInt    idx;
6193 
6194               idx = idxs_V[i];
6195               val = array[idxs_all[idxs_V[i]]];
6196               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6197             }
6198             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6199             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6200             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6201             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6202             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6203           }
6204           sub_schurs->S_Ej_all = S_new;
6205           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6206           if (sub_schurs->sum_S_Ej_all) {
6207             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6208             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6209             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6210             if (pcbddc->deluxe_zerorows) {
6211               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6212             }
6213             sub_schurs->sum_S_Ej_all = S_new;
6214             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6215           }
6216           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6217           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6218         }
6219         /* destroy any change of basis context in sub_schurs */
6220         if (sub_schurs && sub_schurs->change) {
6221           PetscInt i;
6222 
6223           for (i=0;i<sub_schurs->n_subs;i++) {
6224             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6225           }
6226           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6227         }
6228       }
6229       if (pcbddc->switch_static) { /* need to save the local change */
6230         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6231       } else {
6232         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6233       }
6234       /* determine if any process has changed the pressures locally */
6235       pcbddc->change_interior = pcbddc->benign_have_null;
6236     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6237       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6238       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6239       pcbddc->use_qr_single = qr_needed;
6240     }
6241   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6242     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6243       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6244       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6245     } else {
6246       Mat benign_global = NULL;
6247       if (pcbddc->benign_have_null) {
6248         Mat tmat;
6249 
6250         pcbddc->change_interior = PETSC_TRUE;
6251         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6252         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6253         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6254         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6255         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6256         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6257         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6258         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6259         if (pcbddc->benign_change) {
6260           Mat M;
6261 
6262           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6263           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6264           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6265           ierr = MatDestroy(&M);CHKERRQ(ierr);
6266         } else {
6267           Mat         eye;
6268           PetscScalar *array;
6269 
6270           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6271           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6272           for (i=0;i<pcis->n;i++) {
6273             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6274           }
6275           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6276           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6277           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6278           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6279           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6280         }
6281         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6282         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6283       }
6284       if (pcbddc->user_ChangeOfBasisMatrix) {
6285         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6286         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6287       } else if (pcbddc->benign_have_null) {
6288         pcbddc->ChangeOfBasisMatrix = benign_global;
6289       }
6290     }
6291     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6292       IS             is_global;
6293       const PetscInt *gidxs;
6294 
6295       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6296       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6297       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6298       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6299       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6300     }
6301   }
6302   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6303     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6304   }
6305 
6306   if (!pcbddc->fake_change) {
6307     /* add pressure dofs to set of primal nodes for numbering purposes */
6308     for (i=0;i<pcbddc->benign_n;i++) {
6309       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6310       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6311       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6312       pcbddc->local_primal_size_cc++;
6313       pcbddc->local_primal_size++;
6314     }
6315 
6316     /* check if a new primal space has been introduced (also take into account benign trick) */
6317     pcbddc->new_primal_space_local = PETSC_TRUE;
6318     if (olocal_primal_size == pcbddc->local_primal_size) {
6319       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6320       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6321       if (!pcbddc->new_primal_space_local) {
6322         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6323         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6324       }
6325     }
6326     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6327     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6328   }
6329   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6330 
6331   /* flush dbg viewer */
6332   if (pcbddc->dbg_flag) {
6333     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6334   }
6335 
6336   /* free workspace */
6337   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6338   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6339   if (!pcbddc->adaptive_selection) {
6340     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6341     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6342   } else {
6343     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6344                       pcbddc->adaptive_constraints_idxs_ptr,
6345                       pcbddc->adaptive_constraints_data_ptr,
6346                       pcbddc->adaptive_constraints_idxs,
6347                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6348     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6349     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6350   }
6351   PetscFunctionReturn(0);
6352 }
6353 
6354 #undef __FUNCT__
6355 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6356 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6357 {
6358   ISLocalToGlobalMapping map;
6359   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6360   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6361   PetscInt               i,N;
6362   PetscBool              rcsr = PETSC_FALSE;
6363   PetscErrorCode         ierr;
6364 
6365   PetscFunctionBegin;
6366   if (pcbddc->recompute_topography) {
6367     pcbddc->graphanalyzed = PETSC_FALSE;
6368     /* Reset previously computed graph */
6369     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6370     /* Init local Graph struct */
6371     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6372     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6373     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6374 
6375     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6376       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6377     }
6378     /* Check validity of the csr graph passed in by the user */
6379     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);
6380 
6381     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6382     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6383       PetscInt  *xadj,*adjncy;
6384       PetscInt  nvtxs;
6385       PetscBool flg_row=PETSC_FALSE;
6386 
6387       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6388       if (flg_row) {
6389         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6390         pcbddc->computed_rowadj = PETSC_TRUE;
6391       }
6392       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6393       rcsr = PETSC_TRUE;
6394     }
6395     if (pcbddc->dbg_flag) {
6396       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6397     }
6398 
6399     /* Setup of Graph */
6400     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6401     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6402 
6403     /* attach info on disconnected subdomains if present */
6404     if (pcbddc->n_local_subs) {
6405       PetscInt *local_subs;
6406 
6407       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6408       for (i=0;i<pcbddc->n_local_subs;i++) {
6409         const PetscInt *idxs;
6410         PetscInt       nl,j;
6411 
6412         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6413         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6414         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6415         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6416       }
6417       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6418       pcbddc->mat_graph->local_subs = local_subs;
6419     }
6420   }
6421 
6422   if (!pcbddc->graphanalyzed) {
6423     /* Graph's connected components analysis */
6424     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6425     pcbddc->graphanalyzed = PETSC_TRUE;
6426   }
6427   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6428   PetscFunctionReturn(0);
6429 }
6430 
6431 #undef __FUNCT__
6432 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6433 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6434 {
6435   PetscInt       i,j;
6436   PetscScalar    *alphas;
6437   PetscErrorCode ierr;
6438 
6439   PetscFunctionBegin;
6440   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6441   for (i=0;i<n;i++) {
6442     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6443     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6444     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6445     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6446   }
6447   ierr = PetscFree(alphas);CHKERRQ(ierr);
6448   PetscFunctionReturn(0);
6449 }
6450 
6451 #undef __FUNCT__
6452 #define __FUNCT__ "PCBDDCMatISGetSubassemblingPattern"
6453 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6454 {
6455   Mat            A;
6456   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6457   PetscMPIInt    size,rank,color;
6458   PetscInt       *xadj,*adjncy;
6459   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6460   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6461   PetscInt       void_procs,*procs_candidates = NULL;
6462   PetscInt       xadj_count,*count;
6463   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6464   PetscSubcomm   psubcomm;
6465   MPI_Comm       subcomm;
6466   PetscErrorCode ierr;
6467 
6468   PetscFunctionBegin;
6469   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6470   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6471   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6472   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6473   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6474   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6475 
6476   if (have_void) *have_void = PETSC_FALSE;
6477   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6478   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6479   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6480   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6481   im_active = !!n;
6482   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6483   void_procs = size - active_procs;
6484   /* get ranks of of non-active processes in mat communicator */
6485   if (void_procs) {
6486     PetscInt ncand;
6487 
6488     if (have_void) *have_void = PETSC_TRUE;
6489     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6490     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6491     for (i=0,ncand=0;i<size;i++) {
6492       if (!procs_candidates[i]) {
6493         procs_candidates[ncand++] = i;
6494       }
6495     }
6496     /* force n_subdomains to be not greater that the number of non-active processes */
6497     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6498   }
6499 
6500   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6501      number of subdomains requested 1 -> send to master or first candidate in voids  */
6502   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6503   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6504     PetscInt issize,isidx,dest;
6505     if (*n_subdomains == 1) dest = 0;
6506     else dest = rank;
6507     if (im_active) {
6508       issize = 1;
6509       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6510         isidx = procs_candidates[dest];
6511       } else {
6512         isidx = dest;
6513       }
6514     } else {
6515       issize = 0;
6516       isidx = -1;
6517     }
6518     if (*n_subdomains != 1) *n_subdomains = active_procs;
6519     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6520     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6521     PetscFunctionReturn(0);
6522   }
6523   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6524   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6525   threshold = PetscMax(threshold,2);
6526 
6527   /* Get info on mapping */
6528   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6529 
6530   /* build local CSR graph of subdomains' connectivity */
6531   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6532   xadj[0] = 0;
6533   xadj[1] = PetscMax(n_neighs-1,0);
6534   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6535   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6536   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6537   for (i=1;i<n_neighs;i++)
6538     for (j=0;j<n_shared[i];j++)
6539       count[shared[i][j]] += 1;
6540 
6541   xadj_count = 0;
6542   for (i=1;i<n_neighs;i++) {
6543     for (j=0;j<n_shared[i];j++) {
6544       if (count[shared[i][j]] < threshold) {
6545         adjncy[xadj_count] = neighs[i];
6546         adjncy_wgt[xadj_count] = n_shared[i];
6547         xadj_count++;
6548         break;
6549       }
6550     }
6551   }
6552   xadj[1] = xadj_count;
6553   ierr = PetscFree(count);CHKERRQ(ierr);
6554   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6555   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6556 
6557   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6558 
6559   /* Restrict work on active processes only */
6560   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6561   if (void_procs) {
6562     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6563     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6564     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6565     subcomm = PetscSubcommChild(psubcomm);
6566   } else {
6567     psubcomm = NULL;
6568     subcomm = PetscObjectComm((PetscObject)mat);
6569   }
6570 
6571   v_wgt = NULL;
6572   if (!color) {
6573     ierr = PetscFree(xadj);CHKERRQ(ierr);
6574     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6575     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6576   } else {
6577     Mat             subdomain_adj;
6578     IS              new_ranks,new_ranks_contig;
6579     MatPartitioning partitioner;
6580     PetscInt        rstart=0,rend=0;
6581     PetscInt        *is_indices,*oldranks;
6582     PetscMPIInt     size;
6583     PetscBool       aggregate;
6584 
6585     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6586     if (void_procs) {
6587       PetscInt prank = rank;
6588       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6589       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6590       for (i=0;i<xadj[1];i++) {
6591         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6592       }
6593       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6594     } else {
6595       oldranks = NULL;
6596     }
6597     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6598     if (aggregate) { /* TODO: all this part could be made more efficient */
6599       PetscInt    lrows,row,ncols,*cols;
6600       PetscMPIInt nrank;
6601       PetscScalar *vals;
6602 
6603       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6604       lrows = 0;
6605       if (nrank<redprocs) {
6606         lrows = size/redprocs;
6607         if (nrank<size%redprocs) lrows++;
6608       }
6609       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6610       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6611       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6612       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6613       row = nrank;
6614       ncols = xadj[1]-xadj[0];
6615       cols = adjncy;
6616       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6617       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6618       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6619       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6620       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6621       ierr = PetscFree(xadj);CHKERRQ(ierr);
6622       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6623       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6624       ierr = PetscFree(vals);CHKERRQ(ierr);
6625       if (use_vwgt) {
6626         Vec               v;
6627         const PetscScalar *array;
6628         PetscInt          nl;
6629 
6630         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6631         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6632         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6633         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6634         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6635         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6636         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6637         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6638         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6639         ierr = VecDestroy(&v);CHKERRQ(ierr);
6640       }
6641     } else {
6642       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6643       if (use_vwgt) {
6644         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6645         v_wgt[0] = n;
6646       }
6647     }
6648     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6649 
6650     /* Partition */
6651     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6652     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6653     if (v_wgt) {
6654       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6655     }
6656     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6657     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6658     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6659     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6660     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6661 
6662     /* renumber new_ranks to avoid "holes" in new set of processors */
6663     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6664     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6665     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6666     if (!aggregate) {
6667       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6668 #if defined(PETSC_USE_DEBUG)
6669         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6670 #endif
6671         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6672       } else if (oldranks) {
6673         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6674       } else {
6675         ranks_send_to_idx[0] = is_indices[0];
6676       }
6677     } else {
6678       PetscInt    idxs[1];
6679       PetscMPIInt tag;
6680       MPI_Request *reqs;
6681 
6682       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6683       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6684       for (i=rstart;i<rend;i++) {
6685         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6686       }
6687       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6688       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6689       ierr = PetscFree(reqs);CHKERRQ(ierr);
6690       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6691 #if defined(PETSC_USE_DEBUG)
6692         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6693 #endif
6694         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6695       } else if (oldranks) {
6696         ranks_send_to_idx[0] = oldranks[idxs[0]];
6697       } else {
6698         ranks_send_to_idx[0] = idxs[0];
6699       }
6700     }
6701     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6702     /* clean up */
6703     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6704     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6705     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6706     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6707   }
6708   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6709   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6710 
6711   /* assemble parallel IS for sends */
6712   i = 1;
6713   if (!color) i=0;
6714   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6715   PetscFunctionReturn(0);
6716 }
6717 
6718 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6719 
6720 #undef __FUNCT__
6721 #define __FUNCT__ "PCBDDCMatISSubassemble"
6722 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[])
6723 {
6724   Mat                    local_mat;
6725   IS                     is_sends_internal;
6726   PetscInt               rows,cols,new_local_rows;
6727   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6728   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6729   ISLocalToGlobalMapping l2gmap;
6730   PetscInt*              l2gmap_indices;
6731   const PetscInt*        is_indices;
6732   MatType                new_local_type;
6733   /* buffers */
6734   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6735   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6736   PetscInt               *recv_buffer_idxs_local;
6737   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6738   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6739   /* MPI */
6740   MPI_Comm               comm,comm_n;
6741   PetscSubcomm           subcomm;
6742   PetscMPIInt            n_sends,n_recvs,commsize;
6743   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6744   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6745   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6746   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6747   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6748   PetscErrorCode         ierr;
6749 
6750   PetscFunctionBegin;
6751   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6752   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6753   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6754   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6755   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6756   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6757   PetscValidLogicalCollectiveBool(mat,reuse,6);
6758   PetscValidLogicalCollectiveInt(mat,nis,8);
6759   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6760   if (nvecs) {
6761     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6762     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6763   }
6764   /* further checks */
6765   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6766   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6767   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6768   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6769   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6770   if (reuse && *mat_n) {
6771     PetscInt mrows,mcols,mnrows,mncols;
6772     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6773     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6774     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6775     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6776     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6777     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6778     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6779   }
6780   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6781   PetscValidLogicalCollectiveInt(mat,bs,0);
6782 
6783   /* prepare IS for sending if not provided */
6784   if (!is_sends) {
6785     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6786     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6787   } else {
6788     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6789     is_sends_internal = is_sends;
6790   }
6791 
6792   /* get comm */
6793   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6794 
6795   /* compute number of sends */
6796   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6797   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6798 
6799   /* compute number of receives */
6800   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6801   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6802   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6803   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6804   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6805   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6806   ierr = PetscFree(iflags);CHKERRQ(ierr);
6807 
6808   /* restrict comm if requested */
6809   subcomm = 0;
6810   destroy_mat = PETSC_FALSE;
6811   if (restrict_comm) {
6812     PetscMPIInt color,subcommsize;
6813 
6814     color = 0;
6815     if (restrict_full) {
6816       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6817     } else {
6818       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6819     }
6820     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6821     subcommsize = commsize - subcommsize;
6822     /* check if reuse has been requested */
6823     if (reuse) {
6824       if (*mat_n) {
6825         PetscMPIInt subcommsize2;
6826         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6827         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6828         comm_n = PetscObjectComm((PetscObject)*mat_n);
6829       } else {
6830         comm_n = PETSC_COMM_SELF;
6831       }
6832     } else { /* MAT_INITIAL_MATRIX */
6833       PetscMPIInt rank;
6834 
6835       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6836       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6837       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6838       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6839       comm_n = PetscSubcommChild(subcomm);
6840     }
6841     /* flag to destroy *mat_n if not significative */
6842     if (color) destroy_mat = PETSC_TRUE;
6843   } else {
6844     comm_n = comm;
6845   }
6846 
6847   /* prepare send/receive buffers */
6848   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6849   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6850   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6851   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6852   if (nis) {
6853     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6854   }
6855 
6856   /* Get data from local matrices */
6857   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6858     /* TODO: See below some guidelines on how to prepare the local buffers */
6859     /*
6860        send_buffer_vals should contain the raw values of the local matrix
6861        send_buffer_idxs should contain:
6862        - MatType_PRIVATE type
6863        - PetscInt        size_of_l2gmap
6864        - PetscInt        global_row_indices[size_of_l2gmap]
6865        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6866     */
6867   else {
6868     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6869     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6870     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6871     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6872     send_buffer_idxs[1] = i;
6873     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6874     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6875     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6876     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6877     for (i=0;i<n_sends;i++) {
6878       ilengths_vals[is_indices[i]] = len*len;
6879       ilengths_idxs[is_indices[i]] = len+2;
6880     }
6881   }
6882   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6883   /* additional is (if any) */
6884   if (nis) {
6885     PetscMPIInt psum;
6886     PetscInt j;
6887     for (j=0,psum=0;j<nis;j++) {
6888       PetscInt plen;
6889       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6890       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6891       psum += len+1; /* indices + lenght */
6892     }
6893     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6894     for (j=0,psum=0;j<nis;j++) {
6895       PetscInt plen;
6896       const PetscInt *is_array_idxs;
6897       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6898       send_buffer_idxs_is[psum] = plen;
6899       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6900       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6901       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6902       psum += plen+1; /* indices + lenght */
6903     }
6904     for (i=0;i<n_sends;i++) {
6905       ilengths_idxs_is[is_indices[i]] = psum;
6906     }
6907     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6908   }
6909 
6910   buf_size_idxs = 0;
6911   buf_size_vals = 0;
6912   buf_size_idxs_is = 0;
6913   buf_size_vecs = 0;
6914   for (i=0;i<n_recvs;i++) {
6915     buf_size_idxs += (PetscInt)olengths_idxs[i];
6916     buf_size_vals += (PetscInt)olengths_vals[i];
6917     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6918     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6919   }
6920   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6921   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6922   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6923   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6924 
6925   /* get new tags for clean communications */
6926   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6927   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6928   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6929   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6930 
6931   /* allocate for requests */
6932   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6933   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6934   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6935   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6936   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6937   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6938   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6939   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6940 
6941   /* communications */
6942   ptr_idxs = recv_buffer_idxs;
6943   ptr_vals = recv_buffer_vals;
6944   ptr_idxs_is = recv_buffer_idxs_is;
6945   ptr_vecs = recv_buffer_vecs;
6946   for (i=0;i<n_recvs;i++) {
6947     source_dest = onodes[i];
6948     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6949     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6950     ptr_idxs += olengths_idxs[i];
6951     ptr_vals += olengths_vals[i];
6952     if (nis) {
6953       source_dest = onodes_is[i];
6954       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);
6955       ptr_idxs_is += olengths_idxs_is[i];
6956     }
6957     if (nvecs) {
6958       source_dest = onodes[i];
6959       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6960       ptr_vecs += olengths_idxs[i]-2;
6961     }
6962   }
6963   for (i=0;i<n_sends;i++) {
6964     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6965     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6966     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6967     if (nis) {
6968       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);
6969     }
6970     if (nvecs) {
6971       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6972       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6973     }
6974   }
6975   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6976   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6977 
6978   /* assemble new l2g map */
6979   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6980   ptr_idxs = recv_buffer_idxs;
6981   new_local_rows = 0;
6982   for (i=0;i<n_recvs;i++) {
6983     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6984     ptr_idxs += olengths_idxs[i];
6985   }
6986   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6987   ptr_idxs = recv_buffer_idxs;
6988   new_local_rows = 0;
6989   for (i=0;i<n_recvs;i++) {
6990     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6991     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6992     ptr_idxs += olengths_idxs[i];
6993   }
6994   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6995   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6996   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6997 
6998   /* infer new local matrix type from received local matrices type */
6999   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7000   /* 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) */
7001   if (n_recvs) {
7002     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7003     ptr_idxs = recv_buffer_idxs;
7004     for (i=0;i<n_recvs;i++) {
7005       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7006         new_local_type_private = MATAIJ_PRIVATE;
7007         break;
7008       }
7009       ptr_idxs += olengths_idxs[i];
7010     }
7011     switch (new_local_type_private) {
7012       case MATDENSE_PRIVATE:
7013         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
7014           new_local_type = MATSEQAIJ;
7015           bs = 1;
7016         } else { /* if I receive only 1 dense matrix */
7017           new_local_type = MATSEQDENSE;
7018           bs = 1;
7019         }
7020         break;
7021       case MATAIJ_PRIVATE:
7022         new_local_type = MATSEQAIJ;
7023         bs = 1;
7024         break;
7025       case MATBAIJ_PRIVATE:
7026         new_local_type = MATSEQBAIJ;
7027         break;
7028       case MATSBAIJ_PRIVATE:
7029         new_local_type = MATSEQSBAIJ;
7030         break;
7031       default:
7032         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
7033         break;
7034     }
7035   } else { /* by default, new_local_type is seqdense */
7036     new_local_type = MATSEQDENSE;
7037     bs = 1;
7038   }
7039 
7040   /* create MATIS object if needed */
7041   if (!reuse) {
7042     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7043     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7044   } else {
7045     /* it also destroys the local matrices */
7046     if (*mat_n) {
7047       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7048     } else { /* this is a fake object */
7049       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7050     }
7051   }
7052   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7053   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7054 
7055   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7056 
7057   /* Global to local map of received indices */
7058   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7059   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7060   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7061 
7062   /* restore attributes -> type of incoming data and its size */
7063   buf_size_idxs = 0;
7064   for (i=0;i<n_recvs;i++) {
7065     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7066     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7067     buf_size_idxs += (PetscInt)olengths_idxs[i];
7068   }
7069   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7070 
7071   /* set preallocation */
7072   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7073   if (!newisdense) {
7074     PetscInt *new_local_nnz=0;
7075 
7076     ptr_idxs = recv_buffer_idxs_local;
7077     if (n_recvs) {
7078       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7079     }
7080     for (i=0;i<n_recvs;i++) {
7081       PetscInt j;
7082       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7083         for (j=0;j<*(ptr_idxs+1);j++) {
7084           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7085         }
7086       } else {
7087         /* TODO */
7088       }
7089       ptr_idxs += olengths_idxs[i];
7090     }
7091     if (new_local_nnz) {
7092       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7093       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7094       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7095       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7096       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7097       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7098     } else {
7099       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7100     }
7101     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7102   } else {
7103     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7104   }
7105 
7106   /* set values */
7107   ptr_vals = recv_buffer_vals;
7108   ptr_idxs = recv_buffer_idxs_local;
7109   for (i=0;i<n_recvs;i++) {
7110     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7111       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7112       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7113       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7114       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7115       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7116     } else {
7117       /* TODO */
7118     }
7119     ptr_idxs += olengths_idxs[i];
7120     ptr_vals += olengths_vals[i];
7121   }
7122   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7123   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7124   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7125   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7126   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7127 
7128 #if 0
7129   if (!restrict_comm) { /* check */
7130     Vec       lvec,rvec;
7131     PetscReal infty_error;
7132 
7133     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7134     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7135     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7136     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7137     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7138     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7139     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7140     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7141     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7142   }
7143 #endif
7144 
7145   /* assemble new additional is (if any) */
7146   if (nis) {
7147     PetscInt **temp_idxs,*count_is,j,psum;
7148 
7149     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7150     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7151     ptr_idxs = recv_buffer_idxs_is;
7152     psum = 0;
7153     for (i=0;i<n_recvs;i++) {
7154       for (j=0;j<nis;j++) {
7155         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7156         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7157         psum += plen;
7158         ptr_idxs += plen+1; /* shift pointer to received data */
7159       }
7160     }
7161     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7162     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7163     for (i=1;i<nis;i++) {
7164       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7165     }
7166     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7167     ptr_idxs = recv_buffer_idxs_is;
7168     for (i=0;i<n_recvs;i++) {
7169       for (j=0;j<nis;j++) {
7170         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7171         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7172         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7173         ptr_idxs += plen+1; /* shift pointer to received data */
7174       }
7175     }
7176     for (i=0;i<nis;i++) {
7177       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7178       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7179       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7180     }
7181     ierr = PetscFree(count_is);CHKERRQ(ierr);
7182     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7183     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7184   }
7185   /* free workspace */
7186   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7187   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7188   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7189   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7190   if (isdense) {
7191     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7192     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7193   } else {
7194     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7195   }
7196   if (nis) {
7197     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7198     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7199   }
7200 
7201   if (nvecs) {
7202     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7203     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7204     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7205     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7206     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7207     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7208     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7209     /* set values */
7210     ptr_vals = recv_buffer_vecs;
7211     ptr_idxs = recv_buffer_idxs_local;
7212     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7213     for (i=0;i<n_recvs;i++) {
7214       PetscInt j;
7215       for (j=0;j<*(ptr_idxs+1);j++) {
7216         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7217       }
7218       ptr_idxs += olengths_idxs[i];
7219       ptr_vals += olengths_idxs[i]-2;
7220     }
7221     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7222     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7223     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7224   }
7225 
7226   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7227   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7228   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7229   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7230   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7231   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7232   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7233   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7234   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7235   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7236   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7237   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7238   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7239   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7240   ierr = PetscFree(onodes);CHKERRQ(ierr);
7241   if (nis) {
7242     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7243     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7244     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7245   }
7246   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7247   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7248     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7249     for (i=0;i<nis;i++) {
7250       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7251     }
7252     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7253       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7254     }
7255     *mat_n = NULL;
7256   }
7257   PetscFunctionReturn(0);
7258 }
7259 
7260 /* temporary hack into ksp private data structure */
7261 #include <petsc/private/kspimpl.h>
7262 
7263 #undef __FUNCT__
7264 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7265 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7266 {
7267   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7268   PC_IS                  *pcis = (PC_IS*)pc->data;
7269   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7270   Mat                    coarsedivudotp = NULL;
7271   Mat                    coarseG,t_coarse_mat_is;
7272   MatNullSpace           CoarseNullSpace = NULL;
7273   ISLocalToGlobalMapping coarse_islg;
7274   IS                     coarse_is,*isarray;
7275   PetscInt               i,im_active=-1,active_procs=-1;
7276   PetscInt               nis,nisdofs,nisneu,nisvert;
7277   PC                     pc_temp;
7278   PCType                 coarse_pc_type;
7279   KSPType                coarse_ksp_type;
7280   PetscBool              multilevel_requested,multilevel_allowed;
7281   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7282   PetscInt               ncoarse,nedcfield;
7283   PetscBool              compute_vecs = PETSC_FALSE;
7284   PetscScalar            *array;
7285   MatReuse               coarse_mat_reuse;
7286   PetscBool              restr, full_restr, have_void;
7287   PetscErrorCode         ierr;
7288 
7289   PetscFunctionBegin;
7290   /* Assign global numbering to coarse dofs */
7291   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 */
7292     PetscInt ocoarse_size;
7293     compute_vecs = PETSC_TRUE;
7294     ocoarse_size = pcbddc->coarse_size;
7295     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7296     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7297     /* see if we can avoid some work */
7298     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7299       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7300       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7301         PC        pc;
7302         PetscBool isbddc;
7303 
7304         /* temporary workaround since PCBDDC does not have a reset method so far */
7305         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7306         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7307         if (isbddc) {
7308           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7309         } else {
7310           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7311         }
7312         coarse_reuse = PETSC_FALSE;
7313       } else { /* we can safely reuse already computed coarse matrix */
7314         coarse_reuse = PETSC_TRUE;
7315       }
7316     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7317       coarse_reuse = PETSC_FALSE;
7318     }
7319     /* reset any subassembling information */
7320     if (!coarse_reuse || pcbddc->recompute_topography) {
7321       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7322     }
7323   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7324     coarse_reuse = PETSC_TRUE;
7325   }
7326   /* assemble coarse matrix */
7327   if (coarse_reuse && pcbddc->coarse_ksp) {
7328     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7329     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7330     coarse_mat_reuse = MAT_REUSE_MATRIX;
7331   } else {
7332     coarse_mat = NULL;
7333     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7334   }
7335 
7336   /* creates temporary l2gmap and IS for coarse indexes */
7337   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7338   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7339 
7340   /* creates temporary MATIS object for coarse matrix */
7341   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7342   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7343   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7344   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7345   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);
7346   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7347   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7348   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7349   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7350 
7351   /* count "active" (i.e. with positive local size) and "void" processes */
7352   im_active = !!(pcis->n);
7353   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7354 
7355   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7356   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7357   /* full_restr : just use the receivers from the subassembling pattern */
7358   coarse_mat_is = NULL;
7359   multilevel_allowed = PETSC_FALSE;
7360   multilevel_requested = PETSC_FALSE;
7361   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7362   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7363   if (multilevel_requested) {
7364     ncoarse = active_procs/pcbddc->coarsening_ratio;
7365     restr = PETSC_FALSE;
7366     full_restr = PETSC_FALSE;
7367   } else {
7368     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7369     restr = PETSC_TRUE;
7370     full_restr = PETSC_TRUE;
7371   }
7372   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7373   ncoarse = PetscMax(1,ncoarse);
7374   if (!pcbddc->coarse_subassembling) {
7375     if (pcbddc->coarsening_ratio > 1) {
7376       if (multilevel_requested) {
7377         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7378       } else {
7379         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7380       }
7381     } else {
7382       PetscMPIInt size,rank;
7383       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7384       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7385       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7386       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7387     }
7388   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7389     PetscInt    psum;
7390     PetscMPIInt size;
7391     if (pcbddc->coarse_ksp) psum = 1;
7392     else psum = 0;
7393     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7394     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7395     if (ncoarse < size) 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     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7683       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7684       isbddc = PETSC_FALSE;
7685     }
7686     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7687     if (isredundant) {
7688       KSP inner_ksp;
7689       PC  inner_pc;
7690       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7691       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7692       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7693     }
7694 
7695     /* parameters which miss an API */
7696     if (isbddc) {
7697       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7698       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7699       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7700       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7701       if (pcbddc_coarse->benign_saddle_point) {
7702         Mat                    coarsedivudotp_is;
7703         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7704         IS                     row,col;
7705         const PetscInt         *gidxs;
7706         PetscInt               n,st,M,N;
7707 
7708         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7709         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7710         st = st-n;
7711         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7712         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7713         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7714         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7715         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7716         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7717         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7718         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7719         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7720         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7721         ierr = ISDestroy(&row);CHKERRQ(ierr);
7722         ierr = ISDestroy(&col);CHKERRQ(ierr);
7723         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7724         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7725         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7726         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7727         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7728         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7729         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7730         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7731         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7732         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7733         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7734         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7735       }
7736     }
7737 
7738     /* propagate symmetry info of coarse matrix */
7739     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7740     if (pc->pmat->symmetric_set) {
7741       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7742     }
7743     if (pc->pmat->hermitian_set) {
7744       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7745     }
7746     if (pc->pmat->spd_set) {
7747       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7748     }
7749     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7750       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7751     }
7752     /* set operators */
7753     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7754     if (pcbddc->dbg_flag) {
7755       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7756     }
7757   }
7758   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7759   ierr = PetscFree(isarray);CHKERRQ(ierr);
7760 #if 0
7761   {
7762     PetscViewer viewer;
7763     char filename[256];
7764     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7765     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7766     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7767     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7768     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7769     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7770   }
7771 #endif
7772 
7773   if (pcbddc->coarse_ksp) {
7774     Vec crhs,csol;
7775 
7776     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7777     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7778     if (!csol) {
7779       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7780     }
7781     if (!crhs) {
7782       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7783     }
7784   }
7785   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7786 
7787   /* compute null space for coarse solver if the benign trick has been requested */
7788   if (pcbddc->benign_null) {
7789 
7790     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7791     for (i=0;i<pcbddc->benign_n;i++) {
7792       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7793     }
7794     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7795     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7796     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7797     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7798     if (coarse_mat) {
7799       Vec         nullv;
7800       PetscScalar *array,*array2;
7801       PetscInt    nl;
7802 
7803       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7804       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7805       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7806       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7807       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7808       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7809       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7810       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7811       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7812       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7813     }
7814   }
7815 
7816   if (pcbddc->coarse_ksp) {
7817     PetscBool ispreonly;
7818 
7819     if (CoarseNullSpace) {
7820       PetscBool isnull;
7821       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7822       if (isnull) {
7823         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7824       }
7825       /* TODO: add local nullspaces (if any) */
7826     }
7827     /* setup coarse ksp */
7828     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7829     /* Check coarse problem if in debug mode or if solving with an iterative method */
7830     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7831     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7832       KSP       check_ksp;
7833       KSPType   check_ksp_type;
7834       PC        check_pc;
7835       Vec       check_vec,coarse_vec;
7836       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7837       PetscInt  its;
7838       PetscBool compute_eigs;
7839       PetscReal *eigs_r,*eigs_c;
7840       PetscInt  neigs;
7841       const char *prefix;
7842 
7843       /* Create ksp object suitable for estimation of extreme eigenvalues */
7844       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7845       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7846       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7847       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7848       /* prevent from setup unneeded object */
7849       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7850       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7851       if (ispreonly) {
7852         check_ksp_type = KSPPREONLY;
7853         compute_eigs = PETSC_FALSE;
7854       } else {
7855         check_ksp_type = KSPGMRES;
7856         compute_eigs = PETSC_TRUE;
7857       }
7858       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7859       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7860       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7861       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7862       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7863       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7864       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7865       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7866       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7867       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7868       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7869       /* create random vec */
7870       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7871       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7872       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7873       /* solve coarse problem */
7874       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7875       /* set eigenvalue estimation if preonly has not been requested */
7876       if (compute_eigs) {
7877         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7878         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7879         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7880         if (neigs) {
7881           lambda_max = eigs_r[neigs-1];
7882           lambda_min = eigs_r[0];
7883           if (pcbddc->use_coarse_estimates) {
7884             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7885               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7886               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7887             }
7888           }
7889         }
7890       }
7891 
7892       /* check coarse problem residual error */
7893       if (pcbddc->dbg_flag) {
7894         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7895         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7896         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7897         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7898         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7899         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7900         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7901         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7902         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7903         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7904         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7905         if (CoarseNullSpace) {
7906           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7907         }
7908         if (compute_eigs) {
7909           PetscReal          lambda_max_s,lambda_min_s;
7910           KSPConvergedReason reason;
7911           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7912           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7913           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7914           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7915           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);
7916           for (i=0;i<neigs;i++) {
7917             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7918           }
7919         }
7920         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7921         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7922       }
7923       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7924       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7925       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7926       if (compute_eigs) {
7927         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7928         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7929       }
7930     }
7931   }
7932   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7933   /* print additional info */
7934   if (pcbddc->dbg_flag) {
7935     /* waits until all processes reaches this point */
7936     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7937     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7938     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7939   }
7940 
7941   /* free memory */
7942   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7943   PetscFunctionReturn(0);
7944 }
7945 
7946 #undef __FUNCT__
7947 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7948 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7949 {
7950   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7951   PC_IS*         pcis = (PC_IS*)pc->data;
7952   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7953   IS             subset,subset_mult,subset_n;
7954   PetscInt       local_size,coarse_size=0;
7955   PetscInt       *local_primal_indices=NULL;
7956   const PetscInt *t_local_primal_indices;
7957   PetscErrorCode ierr;
7958 
7959   PetscFunctionBegin;
7960   /* Compute global number of coarse dofs */
7961   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7962   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7963   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7964   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7965   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7966   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7967   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7968   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7969   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7970   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);
7971   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7972   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7973   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7974   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7975   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7976 
7977   /* check numbering */
7978   if (pcbddc->dbg_flag) {
7979     PetscScalar coarsesum,*array,*array2;
7980     PetscInt    i;
7981     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7982 
7983     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7984     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7985     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7986     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7987     /* counter */
7988     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7989     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7990     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7991     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7992     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7993     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7994     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7995     for (i=0;i<pcbddc->local_primal_size;i++) {
7996       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7997     }
7998     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7999     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8000     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8001     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8002     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8003     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8004     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8005     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8006     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8007     for (i=0;i<pcis->n;i++) {
8008       if (array[i] != 0.0 && array[i] != array2[i]) {
8009         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8010         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8011         set_error = PETSC_TRUE;
8012         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8013         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);
8014       }
8015     }
8016     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8017     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8018     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8019     for (i=0;i<pcis->n;i++) {
8020       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8021     }
8022     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8023     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8024     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8025     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8026     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8027     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8028     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8029       PetscInt *gidxs;
8030 
8031       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8032       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8033       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8034       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8035       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8036       for (i=0;i<pcbddc->local_primal_size;i++) {
8037         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);
8038       }
8039       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8040       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8041     }
8042     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8043     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8044     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8045   }
8046   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8047   /* get back data */
8048   *coarse_size_n = coarse_size;
8049   *local_primal_indices_n = local_primal_indices;
8050   PetscFunctionReturn(0);
8051 }
8052 
8053 #undef __FUNCT__
8054 #define __FUNCT__ "PCBDDCGlobalToLocal"
8055 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8056 {
8057   IS             localis_t;
8058   PetscInt       i,lsize,*idxs,n;
8059   PetscScalar    *vals;
8060   PetscErrorCode ierr;
8061 
8062   PetscFunctionBegin;
8063   /* get indices in local ordering exploiting local to global map */
8064   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8065   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8066   for (i=0;i<lsize;i++) vals[i] = 1.0;
8067   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8068   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8069   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8070   if (idxs) { /* multilevel guard */
8071     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8072   }
8073   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8074   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8075   ierr = PetscFree(vals);CHKERRQ(ierr);
8076   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8077   /* now compute set in local ordering */
8078   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8079   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8080   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8081   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8082   for (i=0,lsize=0;i<n;i++) {
8083     if (PetscRealPart(vals[i]) > 0.5) {
8084       lsize++;
8085     }
8086   }
8087   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8088   for (i=0,lsize=0;i<n;i++) {
8089     if (PetscRealPart(vals[i]) > 0.5) {
8090       idxs[lsize++] = i;
8091     }
8092   }
8093   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8094   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8095   *localis = localis_t;
8096   PetscFunctionReturn(0);
8097 }
8098 
8099 #undef __FUNCT__
8100 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8101 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8102 {
8103   PC_IS               *pcis=(PC_IS*)pc->data;
8104   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8105   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8106   Mat                 S_j;
8107   PetscInt            *used_xadj,*used_adjncy;
8108   PetscBool           free_used_adj;
8109   PetscErrorCode      ierr;
8110 
8111   PetscFunctionBegin;
8112   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8113   free_used_adj = PETSC_FALSE;
8114   if (pcbddc->sub_schurs_layers == -1) {
8115     used_xadj = NULL;
8116     used_adjncy = NULL;
8117   } else {
8118     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8119       used_xadj = pcbddc->mat_graph->xadj;
8120       used_adjncy = pcbddc->mat_graph->adjncy;
8121     } else if (pcbddc->computed_rowadj) {
8122       used_xadj = pcbddc->mat_graph->xadj;
8123       used_adjncy = pcbddc->mat_graph->adjncy;
8124     } else {
8125       PetscBool      flg_row=PETSC_FALSE;
8126       const PetscInt *xadj,*adjncy;
8127       PetscInt       nvtxs;
8128 
8129       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8130       if (flg_row) {
8131         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8132         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8133         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8134         free_used_adj = PETSC_TRUE;
8135       } else {
8136         pcbddc->sub_schurs_layers = -1;
8137         used_xadj = NULL;
8138         used_adjncy = NULL;
8139       }
8140       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8141     }
8142   }
8143 
8144   /* setup sub_schurs data */
8145   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8146   if (!sub_schurs->schur_explicit) {
8147     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8148     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8149     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);
8150   } else {
8151     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8152     PetscBool isseqaij,need_change = PETSC_FALSE;
8153     PetscInt  benign_n;
8154     Mat       change = NULL;
8155     Vec       scaling = NULL;
8156     IS        change_primal = NULL;
8157 
8158     if (!pcbddc->use_vertices && reuse_solvers) {
8159       PetscInt n_vertices;
8160 
8161       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8162       reuse_solvers = (PetscBool)!n_vertices;
8163     }
8164     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8165     if (!isseqaij) {
8166       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8167       if (matis->A == pcbddc->local_mat) {
8168         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8169         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8170       } else {
8171         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8172       }
8173     }
8174     if (!pcbddc->benign_change_explicit) {
8175       benign_n = pcbddc->benign_n;
8176     } else {
8177       benign_n = 0;
8178     }
8179     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8180        We need a global reduction to avoid possible deadlocks.
8181        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8182     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8183       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8184       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8185       need_change = (PetscBool)(!need_change);
8186     }
8187     /* If the user defines additional constraints, we import them here.
8188        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 */
8189     if (need_change) {
8190       PC_IS   *pcisf;
8191       PC_BDDC *pcbddcf;
8192       PC      pcf;
8193 
8194       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8195       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8196       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8197       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8198       /* hacks */
8199       pcisf = (PC_IS*)pcf->data;
8200       pcisf->is_B_local = pcis->is_B_local;
8201       pcisf->vec1_N = pcis->vec1_N;
8202       pcisf->BtoNmap = pcis->BtoNmap;
8203       pcisf->n = pcis->n;
8204       pcisf->n_B = pcis->n_B;
8205       pcbddcf = (PC_BDDC*)pcf->data;
8206       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8207       pcbddcf->mat_graph = pcbddc->mat_graph;
8208       pcbddcf->use_faces = PETSC_TRUE;
8209       pcbddcf->use_change_of_basis = PETSC_TRUE;
8210       pcbddcf->use_change_on_faces = PETSC_TRUE;
8211       pcbddcf->use_qr_single = PETSC_TRUE;
8212       pcbddcf->fake_change = PETSC_TRUE;
8213       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8214       /* store information on primal vertices and change of basis (in local numbering) */
8215       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8216       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8217       change = pcbddcf->ConstraintMatrix;
8218       pcbddcf->ConstraintMatrix = NULL;
8219       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8220       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8221       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8222       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8223       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8224       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8225       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8226       pcf->ops->destroy = NULL;
8227       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8228     }
8229     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8230     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);
8231     ierr = MatDestroy(&change);CHKERRQ(ierr);
8232     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8233   }
8234   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8235 
8236   /* free adjacency */
8237   if (free_used_adj) {
8238     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8239   }
8240   PetscFunctionReturn(0);
8241 }
8242 
8243 #undef __FUNCT__
8244 #define __FUNCT__ "PCBDDCInitSubSchurs"
8245 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8246 {
8247   PC_IS               *pcis=(PC_IS*)pc->data;
8248   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8249   PCBDDCGraph         graph;
8250   PetscErrorCode      ierr;
8251 
8252   PetscFunctionBegin;
8253   /* attach interface graph for determining subsets */
8254   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8255     IS       verticesIS,verticescomm;
8256     PetscInt vsize,*idxs;
8257 
8258     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8259     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8260     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8261     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8262     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8263     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8264     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8265     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8266     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8267     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8268     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8269   } else {
8270     graph = pcbddc->mat_graph;
8271   }
8272   /* print some info */
8273   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8274     IS       vertices;
8275     PetscInt nv,nedges,nfaces;
8276     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8277     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8278     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8279     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8280     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8281     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8282     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8283     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8284     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8285     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8286     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8287   }
8288 
8289   /* sub_schurs init */
8290   if (!pcbddc->sub_schurs) {
8291     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8292   }
8293   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8294 
8295   /* free graph struct */
8296   if (pcbddc->sub_schurs_rebuild) {
8297     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8298   }
8299   PetscFunctionReturn(0);
8300 }
8301 
8302 #undef __FUNCT__
8303 #define __FUNCT__ "PCBDDCCheckOperator"
8304 PetscErrorCode PCBDDCCheckOperator(PC pc)
8305 {
8306   PC_IS               *pcis=(PC_IS*)pc->data;
8307   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8308   PetscErrorCode      ierr;
8309 
8310   PetscFunctionBegin;
8311   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8312     IS             zerodiag = NULL;
8313     Mat            S_j,B0_B=NULL;
8314     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8315     PetscScalar    *p0_check,*array,*array2;
8316     PetscReal      norm;
8317     PetscInt       i;
8318 
8319     /* B0 and B0_B */
8320     if (zerodiag) {
8321       IS       dummy;
8322 
8323       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8324       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8325       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8326       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8327     }
8328     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8329     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8330     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8331     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8332     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8333     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8334     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8335     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8336     /* S_j */
8337     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8338     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8339 
8340     /* mimic vector in \widetilde{W}_\Gamma */
8341     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8342     /* continuous in primal space */
8343     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8344     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8345     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8346     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8347     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8348     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8349     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8350     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8351     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8352     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8353     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8354     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8355     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8356     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8357 
8358     /* assemble rhs for coarse problem */
8359     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8360     /* local with Schur */
8361     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8362     if (zerodiag) {
8363       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8364       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8365       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8366       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8367     }
8368     /* sum on primal nodes the local contributions */
8369     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8370     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8371     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8372     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8373     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8374     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8375     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8376     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8377     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8378     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8379     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8380     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8381     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8382     /* scale primal nodes (BDDC sums contibutions) */
8383     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8384     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8385     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8386     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8387     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8388     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8389     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8390     /* global: \widetilde{B0}_B w_\Gamma */
8391     if (zerodiag) {
8392       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8393       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8394       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8395       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8396     }
8397     /* BDDC */
8398     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8399     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8400 
8401     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8402     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8403     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8404     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8405     for (i=0;i<pcbddc->benign_n;i++) {
8406       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8407     }
8408     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8409     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8410     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8411     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8412     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8413     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8414   }
8415   PetscFunctionReturn(0);
8416 }
8417 
8418 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8419 #undef __FUNCT__
8420 #define __FUNCT__ "MatMPIAIJRestrict"
8421 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8422 {
8423   Mat            At;
8424   IS             rows;
8425   PetscInt       rst,ren;
8426   PetscErrorCode ierr;
8427   PetscLayout    rmap;
8428 
8429   PetscFunctionBegin;
8430   rst = ren = 0;
8431   if (ccomm != MPI_COMM_NULL) {
8432     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8433     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8434     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8435     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8436     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8437   }
8438   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8439   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8440   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8441 
8442   if (ccomm != MPI_COMM_NULL) {
8443     Mat_MPIAIJ *a,*b;
8444     IS         from,to;
8445     Vec        gvec;
8446     PetscInt   lsize;
8447 
8448     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8449     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8450     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8451     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8452     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8453     a    = (Mat_MPIAIJ*)At->data;
8454     b    = (Mat_MPIAIJ*)(*B)->data;
8455     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8456     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8457     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8458     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8459     b->A = a->A;
8460     b->B = a->B;
8461 
8462     b->donotstash      = a->donotstash;
8463     b->roworiented     = a->roworiented;
8464     b->rowindices      = 0;
8465     b->rowvalues       = 0;
8466     b->getrowactive    = PETSC_FALSE;
8467 
8468     (*B)->rmap         = rmap;
8469     (*B)->factortype   = A->factortype;
8470     (*B)->assembled    = PETSC_TRUE;
8471     (*B)->insertmode   = NOT_SET_VALUES;
8472     (*B)->preallocated = PETSC_TRUE;
8473 
8474     if (a->colmap) {
8475 #if defined(PETSC_USE_CTABLE)
8476       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8477 #else
8478       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8479       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8480       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8481 #endif
8482     } else b->colmap = 0;
8483     if (a->garray) {
8484       PetscInt len;
8485       len  = a->B->cmap->n;
8486       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8487       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8488       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8489     } else b->garray = 0;
8490 
8491     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8492     b->lvec = a->lvec;
8493     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8494 
8495     /* cannot use VecScatterCopy */
8496     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8497     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8498     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8499     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8500     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8501     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8502     ierr = ISDestroy(&from);CHKERRQ(ierr);
8503     ierr = ISDestroy(&to);CHKERRQ(ierr);
8504     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8505   }
8506   ierr = MatDestroy(&At);CHKERRQ(ierr);
8507   PetscFunctionReturn(0);
8508 }
8509