xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 66da6bd709add8ab3dd5102f528e4f1f5445ea2a)
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 = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1498     if (i>=first && i < last) {
1499       PetscScalar *data;
1500       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1501       if (!has_const) {
1502         data[i-first] = 0.;
1503       } else {
1504         data[2*i-first] = 0.;
1505         data[2*i-first+1] = 0.;
1506       }
1507       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1508     }
1509     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1510   }
1511   PetscFunctionReturn(0);
1512 }
1513 
1514 #undef __FUNCT__
1515 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
1516 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1517 {
1518   Mat                    loc_divudotp;
1519   Vec                    p,v,vins,quad_vec,*quad_vecs;
1520   ISLocalToGlobalMapping map;
1521   IS                     *faces,*edges;
1522   PetscScalar            *vals;
1523   const PetscScalar      *array;
1524   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1525   PetscMPIInt            rank;
1526   PetscErrorCode         ierr;
1527 
1528   PetscFunctionBegin;
1529   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1530   if (graph->twodim) {
1531     lmaxneighs = 2;
1532   } else {
1533     lmaxneighs = 1;
1534     for (i=0;i<ne;i++) {
1535       const PetscInt *idxs;
1536       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1537       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1538       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1539     }
1540     lmaxneighs++; /* graph count does not include self */
1541   }
1542   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1543   maxsize = 0;
1544   for (i=0;i<ne;i++) {
1545     PetscInt nn;
1546     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1547     maxsize = PetscMax(maxsize,nn);
1548   }
1549   for (i=0;i<nf;i++) {
1550     PetscInt nn;
1551     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1552     maxsize = PetscMax(maxsize,nn);
1553   }
1554   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1555   /* create vectors to hold quadrature weights */
1556   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1557   if (!transpose) {
1558     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1559   } else {
1560     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1561   }
1562   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1563   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1564   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1565   for (i=0;i<maxneighs;i++) {
1566     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1567   }
1568 
1569   /* compute local quad vec */
1570   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1571   if (!transpose) {
1572     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1573   } else {
1574     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1575   }
1576   ierr = VecSet(p,1.);CHKERRQ(ierr);
1577   if (!transpose) {
1578     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1579   } else {
1580     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1581   }
1582   if (vl2l) {
1583     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1584   } else {
1585     vins = v;
1586   }
1587   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1588   ierr = VecDestroy(&p);CHKERRQ(ierr);
1589 
1590   /* insert in global quadrature vecs */
1591   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1592   for (i=0;i<nf;i++) {
1593     const PetscInt    *idxs;
1594     PetscInt          idx,nn,j;
1595 
1596     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1597     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1598     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1599     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1600     idx = -(idx+1);
1601     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1602     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1603   }
1604   for (i=0;i<ne;i++) {
1605     const PetscInt    *idxs;
1606     PetscInt          idx,nn,j;
1607 
1608     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1609     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1610     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1611     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1612     idx  = -(idx+1);
1613     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1614     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1615   }
1616   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1617   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1618   if (vl2l) {
1619     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1620   }
1621   ierr = VecDestroy(&v);CHKERRQ(ierr);
1622   ierr = PetscFree(vals);CHKERRQ(ierr);
1623 
1624   /* assemble near null space */
1625   for (i=0;i<maxneighs;i++) {
1626     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1627   }
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1632   PetscFunctionReturn(0);
1633 }
1634 
1635 
1636 #undef __FUNCT__
1637 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
1638 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1639 {
1640   PetscErrorCode ierr;
1641   Vec            local,global;
1642   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1643   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1644 
1645   PetscFunctionBegin;
1646   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1647   /* need to convert from global to local topology information and remove references to information in global ordering */
1648   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1649   if (pcbddc->user_provided_isfordofs) {
1650     if (pcbddc->n_ISForDofs) {
1651       PetscInt i;
1652       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1653       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1654         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1655         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1656       }
1657       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1658       pcbddc->n_ISForDofs = 0;
1659       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1660     }
1661   } else {
1662     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
1663       PetscInt i, n = matis->A->rmap->n;
1664       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1665       if (i > 1) {
1666         pcbddc->n_ISForDofsLocal = i;
1667         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1668         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1669           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1670         }
1671       }
1672     }
1673   }
1674 
1675   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1676     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1677   }
1678   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1679     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1680   }
1681   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1683   }
1684   ierr = VecDestroy(&global);CHKERRQ(ierr);
1685   ierr = VecDestroy(&local);CHKERRQ(ierr);
1686   PetscFunctionReturn(0);
1687 }
1688 
1689 #undef __FUNCT__
1690 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
1691 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1692 {
1693   PC_IS             *pcis = (PC_IS*)(pc->data);
1694   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1695   PetscErrorCode    ierr;
1696 
1697   PetscFunctionBegin;
1698   if (!pcbddc->benign_have_null) {
1699     PetscFunctionReturn(0);
1700   }
1701   if (pcbddc->ChangeOfBasisMatrix) {
1702     Vec swap;
1703 
1704     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1705     swap = pcbddc->work_change;
1706     pcbddc->work_change = r;
1707     r = swap;
1708   }
1709   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1710   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1711   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1712   ierr = VecSet(z,0.);CHKERRQ(ierr);
1713   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1714   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1715   if (pcbddc->ChangeOfBasisMatrix) {
1716     pcbddc->work_change = r;
1717     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1718     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1719   }
1720   PetscFunctionReturn(0);
1721 }
1722 
1723 #undef __FUNCT__
1724 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
1725 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1726 {
1727   PCBDDCBenignMatMult_ctx ctx;
1728   PetscErrorCode          ierr;
1729   PetscBool               apply_right,apply_left,reset_x;
1730 
1731   PetscFunctionBegin;
1732   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1733   if (transpose) {
1734     apply_right = ctx->apply_left;
1735     apply_left = ctx->apply_right;
1736   } else {
1737     apply_right = ctx->apply_right;
1738     apply_left = ctx->apply_left;
1739   }
1740   reset_x = PETSC_FALSE;
1741   if (apply_right) {
1742     const PetscScalar *ax;
1743     PetscInt          nl,i;
1744 
1745     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1746     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1747     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1748     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1749     for (i=0;i<ctx->benign_n;i++) {
1750       PetscScalar    sum,val;
1751       const PetscInt *idxs;
1752       PetscInt       nz,j;
1753       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1754       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1755       sum = 0.;
1756       if (ctx->apply_p0) {
1757         val = ctx->work[idxs[nz-1]];
1758         for (j=0;j<nz-1;j++) {
1759           sum += ctx->work[idxs[j]];
1760           ctx->work[idxs[j]] += val;
1761         }
1762       } else {
1763         for (j=0;j<nz-1;j++) {
1764           sum += ctx->work[idxs[j]];
1765         }
1766       }
1767       ctx->work[idxs[nz-1]] -= sum;
1768       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1769     }
1770     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1771     reset_x = PETSC_TRUE;
1772   }
1773   if (transpose) {
1774     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1775   } else {
1776     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1777   }
1778   if (reset_x) {
1779     ierr = VecResetArray(x);CHKERRQ(ierr);
1780   }
1781   if (apply_left) {
1782     PetscScalar *ay;
1783     PetscInt    i;
1784 
1785     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1786     for (i=0;i<ctx->benign_n;i++) {
1787       PetscScalar    sum,val;
1788       const PetscInt *idxs;
1789       PetscInt       nz,j;
1790       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1791       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1792       val = -ay[idxs[nz-1]];
1793       if (ctx->apply_p0) {
1794         sum = 0.;
1795         for (j=0;j<nz-1;j++) {
1796           sum += ay[idxs[j]];
1797           ay[idxs[j]] += val;
1798         }
1799         ay[idxs[nz-1]] += sum;
1800       } else {
1801         for (j=0;j<nz-1;j++) {
1802           ay[idxs[j]] += val;
1803         }
1804         ay[idxs[nz-1]] = 0.;
1805       }
1806       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1807     }
1808     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1809   }
1810   PetscFunctionReturn(0);
1811 }
1812 
1813 #undef __FUNCT__
1814 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
1815 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1816 {
1817   PetscErrorCode ierr;
1818 
1819   PetscFunctionBegin;
1820   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1821   PetscFunctionReturn(0);
1822 }
1823 
1824 #undef __FUNCT__
1825 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
1826 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1827 {
1828   PetscErrorCode ierr;
1829 
1830   PetscFunctionBegin;
1831   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1832   PetscFunctionReturn(0);
1833 }
1834 
1835 #undef __FUNCT__
1836 #define __FUNCT__ "PCBDDCBenignShellMat"
1837 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1838 {
1839   PC_IS                   *pcis = (PC_IS*)pc->data;
1840   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1841   PCBDDCBenignMatMult_ctx ctx;
1842   PetscErrorCode          ierr;
1843 
1844   PetscFunctionBegin;
1845   if (!restore) {
1846     Mat                A_IB,A_BI;
1847     PetscScalar        *work;
1848     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1849 
1850     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1851     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1852     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1853     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1854     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1855     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1856     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1857     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1858     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1859     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1860     ctx->apply_left = PETSC_TRUE;
1861     ctx->apply_right = PETSC_FALSE;
1862     ctx->apply_p0 = PETSC_FALSE;
1863     ctx->benign_n = pcbddc->benign_n;
1864     if (reuse) {
1865       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1866       ctx->free = PETSC_FALSE;
1867     } else { /* TODO: could be optimized for successive solves */
1868       ISLocalToGlobalMapping N_to_D;
1869       PetscInt               i;
1870 
1871       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1872       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1873       for (i=0;i<pcbddc->benign_n;i++) {
1874         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1875       }
1876       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1877       ctx->free = PETSC_TRUE;
1878     }
1879     ctx->A = pcis->A_IB;
1880     ctx->work = work;
1881     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1882     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1883     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1884     pcis->A_IB = A_IB;
1885 
1886     /* A_BI as A_IB^T */
1887     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1888     pcbddc->benign_original_mat = pcis->A_BI;
1889     pcis->A_BI = A_BI;
1890   } else {
1891     if (!pcbddc->benign_original_mat) {
1892       PetscFunctionReturn(0);
1893     }
1894     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1895     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1896     pcis->A_IB = ctx->A;
1897     ctx->A = NULL;
1898     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1899     pcis->A_BI = pcbddc->benign_original_mat;
1900     pcbddc->benign_original_mat = NULL;
1901     if (ctx->free) {
1902       PetscInt i;
1903       for (i=0;i<ctx->benign_n;i++) {
1904         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1905       }
1906       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1907     }
1908     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1909     ierr = PetscFree(ctx);CHKERRQ(ierr);
1910   }
1911   PetscFunctionReturn(0);
1912 }
1913 
1914 /* used just in bddc debug mode */
1915 #undef __FUNCT__
1916 #define __FUNCT__ "PCBDDCBenignProject"
1917 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1918 {
1919   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1920   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1921   Mat            An;
1922   PetscErrorCode ierr;
1923 
1924   PetscFunctionBegin;
1925   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1926   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1927   if (is1) {
1928     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1929     ierr = MatDestroy(&An);CHKERRQ(ierr);
1930   } else {
1931     *B = An;
1932   }
1933   PetscFunctionReturn(0);
1934 }
1935 
1936 /* TODO: add reuse flag */
1937 #undef __FUNCT__
1938 #define __FUNCT__ "MatSeqAIJCompress"
1939 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
1940 {
1941   Mat            Bt;
1942   PetscScalar    *a,*bdata;
1943   const PetscInt *ii,*ij;
1944   PetscInt       m,n,i,nnz,*bii,*bij;
1945   PetscBool      flg_row;
1946   PetscErrorCode ierr;
1947 
1948   PetscFunctionBegin;
1949   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
1950   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
1951   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
1952   nnz = n;
1953   for (i=0;i<ii[n];i++) {
1954     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
1955   }
1956   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
1957   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
1958   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
1959   nnz = 0;
1960   bii[0] = 0;
1961   for (i=0;i<n;i++) {
1962     PetscInt j;
1963     for (j=ii[i];j<ii[i+1];j++) {
1964       PetscScalar entry = a[j];
1965       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
1966         bij[nnz] = ij[j];
1967         bdata[nnz] = entry;
1968         nnz++;
1969       }
1970     }
1971     bii[i+1] = nnz;
1972   }
1973   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
1974   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
1975   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
1976   {
1977     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
1978     b->free_a = PETSC_TRUE;
1979     b->free_ij = PETSC_TRUE;
1980   }
1981   *B = Bt;
1982   PetscFunctionReturn(0);
1983 }
1984 
1985 #undef __FUNCT__
1986 #define __FUNCT__ "MatDetectDisconnectedComponents"
1987 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
1988 {
1989   Mat                    B;
1990   IS                     is_dummy,*cc_n;
1991   ISLocalToGlobalMapping l2gmap_dummy;
1992   PCBDDCGraph            graph;
1993   PetscInt               i,n;
1994   PetscInt               *xadj,*adjncy;
1995   PetscInt               *xadj_filtered,*adjncy_filtered;
1996   PetscBool              flg_row,isseqaij;
1997   PetscErrorCode         ierr;
1998 
1999   PetscFunctionBegin;
2000   if (!A->rmap->N || !A->cmap->N) {
2001     *ncc = 0;
2002     *cc = NULL;
2003     PetscFunctionReturn(0);
2004   }
2005   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2006   if (!isseqaij && filter) {
2007     PetscBool isseqdense;
2008 
2009     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2010     if (!isseqdense) {
2011       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2012     } else { /* TODO: rectangular case and LDA */
2013       PetscScalar *array;
2014       PetscReal   chop=1.e-6;
2015 
2016       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2017       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2018       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2019       for (i=0;i<n;i++) {
2020         PetscInt j;
2021         for (j=i+1;j<n;j++) {
2022           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2023           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2024           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2025         }
2026       }
2027       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2028       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2029     }
2030   } else {
2031     B = A;
2032   }
2033   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2034 
2035   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2036   if (filter) {
2037     PetscScalar *data;
2038     PetscInt    j,cum;
2039 
2040     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2041     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2042     cum = 0;
2043     for (i=0;i<n;i++) {
2044       PetscInt t;
2045 
2046       for (j=xadj[i];j<xadj[i+1];j++) {
2047         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2048           continue;
2049         }
2050         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2051       }
2052       t = xadj_filtered[i];
2053       xadj_filtered[i] = cum;
2054       cum += t;
2055     }
2056     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2057   } else {
2058     xadj_filtered = NULL;
2059     adjncy_filtered = NULL;
2060   }
2061 
2062   /* compute local connected components using PCBDDCGraph */
2063   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2064   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2065   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2066   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2067   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2068   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2069   if (xadj_filtered) {
2070     graph->xadj = xadj_filtered;
2071     graph->adjncy = adjncy_filtered;
2072   } else {
2073     graph->xadj = xadj;
2074     graph->adjncy = adjncy;
2075   }
2076   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2077   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2078   /* partial clean up */
2079   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2080   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2081   if (A != B) {
2082     ierr = MatDestroy(&B);CHKERRQ(ierr);
2083   }
2084 
2085   /* get back data */
2086   if (ncc) *ncc = graph->ncc;
2087   if (cc) {
2088     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2089     for (i=0;i<graph->ncc;i++) {
2090       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);
2091     }
2092     *cc = cc_n;
2093   }
2094   /* clean up graph */
2095   graph->xadj = 0;
2096   graph->adjncy = 0;
2097   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2098   PetscFunctionReturn(0);
2099 }
2100 
2101 #undef __FUNCT__
2102 #define __FUNCT__ "PCBDDCBenignCheck"
2103 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2104 {
2105   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2106   PC_IS*         pcis = (PC_IS*)(pc->data);
2107   IS             dirIS = NULL;
2108   PetscInt       i;
2109   PetscErrorCode ierr;
2110 
2111   PetscFunctionBegin;
2112   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2113   if (zerodiag) {
2114     Mat            A;
2115     Vec            vec3_N;
2116     PetscScalar    *vals;
2117     const PetscInt *idxs;
2118     PetscInt       nz,*count;
2119 
2120     /* p0 */
2121     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2122     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2123     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2124     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2125     for (i=0;i<nz;i++) vals[i] = 1.;
2126     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2127     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2128     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2129     /* v_I */
2130     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2131     for (i=0;i<nz;i++) vals[i] = 0.;
2132     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2133     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2134     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2135     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2136     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2137     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2138     if (dirIS) {
2139       PetscInt n;
2140 
2141       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2142       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2143       for (i=0;i<n;i++) vals[i] = 0.;
2144       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2145       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2146     }
2147     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2148     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2149     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2150     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2151     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2152     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2153     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2154     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]));
2155     ierr = PetscFree(vals);CHKERRQ(ierr);
2156     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2157 
2158     /* there should not be any pressure dofs lying on the interface */
2159     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2160     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2161     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2162     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2163     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2164     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]);
2165     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2166     ierr = PetscFree(count);CHKERRQ(ierr);
2167   }
2168   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2169 
2170   /* check PCBDDCBenignGetOrSetP0 */
2171   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2172   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2173   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2174   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2175   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2176   for (i=0;i<pcbddc->benign_n;i++) {
2177     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2178     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);
2179   }
2180   PetscFunctionReturn(0);
2181 }
2182 
2183 #undef __FUNCT__
2184 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
2185 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2186 {
2187   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2188   IS             pressures,zerodiag,*zerodiag_subs;
2189   PetscInt       nz,n;
2190   PetscInt       *interior_dofs,n_interior_dofs;
2191   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag;
2192   PetscErrorCode ierr;
2193 
2194   PetscFunctionBegin;
2195   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2196   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2197   for (n=0;n<pcbddc->benign_n;n++) {
2198     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2199   }
2200   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2201   pcbddc->benign_n = 0;
2202   /* if a local info on dofs is present, assumes that the last field represents  "pressures"
2203      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2204      Checks if all the pressure dofs in each subdomain have a zero diagonal
2205      If not, a change of basis on pressures is not needed
2206      since the local Schur complements are already SPD
2207   */
2208   has_null_pressures = PETSC_TRUE;
2209   have_null = PETSC_TRUE;
2210   if (pcbddc->n_ISForDofsLocal) {
2211     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2212 
2213     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2214     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2215     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2216     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2217     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2218     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2219     if (!sorted) {
2220       ierr = ISSort(pressures);CHKERRQ(ierr);
2221     }
2222   } else {
2223     pressures = NULL;
2224   }
2225   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2226   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2227   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2228   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2229   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2230   if (!sorted) {
2231     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2232   }
2233   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2234   if (!nz) {
2235     if (n) have_null = PETSC_FALSE;
2236     has_null_pressures = PETSC_FALSE;
2237     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2238   }
2239   recompute_zerodiag = PETSC_FALSE;
2240   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2241   zerodiag_subs = NULL;
2242   pcbddc->benign_n = 0;
2243   n_interior_dofs = 0;
2244   interior_dofs = NULL;
2245   if (pcbddc->current_level) { /* need to compute interior nodes */
2246     PetscInt n,i,j;
2247     PetscInt n_neigh,*neigh,*n_shared,**shared;
2248     PetscInt *iwork;
2249 
2250     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2251     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2252     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2253     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2254     for (i=1;i<n_neigh;i++)
2255       for (j=0;j<n_shared[i];j++)
2256           iwork[shared[i][j]] += 1;
2257     for (i=0;i<n;i++)
2258       if (!iwork[i])
2259         interior_dofs[n_interior_dofs++] = i;
2260     ierr = PetscFree(iwork);CHKERRQ(ierr);
2261     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2262   }
2263   if (has_null_pressures) {
2264     IS             *subs;
2265     PetscInt       nsubs,i,j,nl;
2266     const PetscInt *idxs;
2267     PetscScalar    *array;
2268     Vec            *work;
2269     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2270 
2271     subs = pcbddc->local_subs;
2272     nsubs = pcbddc->n_local_subs;
2273     /* 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) */
2274     if (pcbddc->current_level) {
2275       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2276       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2277       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2278       /* work[0] = 1_p */
2279       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2280       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2281       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2282       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2283       /* work[0] = 1_v */
2284       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2285       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2286       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2287       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2288       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2289     }
2290     if (nsubs > 1) {
2291       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2292       for (i=0;i<nsubs;i++) {
2293         ISLocalToGlobalMapping l2g;
2294         IS                     t_zerodiag_subs;
2295         PetscInt               nl;
2296 
2297         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2298         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2299         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2300         if (nl) {
2301           PetscBool valid = PETSC_TRUE;
2302 
2303           if (pcbddc->current_level) {
2304             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2305             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2306             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2307             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2308             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2309             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2310             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2311             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2312             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2313             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2314             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2315             for (j=0;j<n_interior_dofs;j++) {
2316               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2317                 valid = PETSC_FALSE;
2318                 break;
2319               }
2320             }
2321             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2322           }
2323           if (valid && pcbddc->NeumannBoundariesLocal) {
2324             IS       t_bc;
2325             PetscInt nzb;
2326 
2327             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pcbddc->NeumannBoundariesLocal,&t_bc);CHKERRQ(ierr);
2328             ierr = ISGetLocalSize(t_bc,&nzb);CHKERRQ(ierr);
2329             ierr = ISDestroy(&t_bc);CHKERRQ(ierr);
2330             if (nzb) valid = PETSC_FALSE;
2331           }
2332           if (valid && pressures) {
2333             IS t_pressure_subs;
2334             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2335             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2336             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2337           }
2338           if (valid) {
2339             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2340             pcbddc->benign_n++;
2341           } else {
2342             recompute_zerodiag = PETSC_TRUE;
2343           }
2344         }
2345         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2346         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2347       }
2348     } else { /* there's just one subdomain (or zero if they have not been detected */
2349       PetscBool valid = PETSC_TRUE;
2350 
2351       if (pcbddc->NeumannBoundariesLocal) {
2352         PetscInt nzb;
2353         ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nzb);CHKERRQ(ierr);
2354         if (nzb) valid = PETSC_FALSE;
2355       }
2356       if (valid && pressures) {
2357         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2358       }
2359       if (valid && pcbddc->current_level) {
2360         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2361         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2362         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2363         for (j=0;j<n_interior_dofs;j++) {
2364             if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2365               valid = PETSC_FALSE;
2366               break;
2367           }
2368         }
2369         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2370       }
2371       if (valid) {
2372         pcbddc->benign_n = 1;
2373         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2374         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2375         zerodiag_subs[0] = zerodiag;
2376       }
2377     }
2378     if (pcbddc->current_level) {
2379       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2380     }
2381   }
2382   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2383 
2384   if (!pcbddc->benign_n) {
2385     PetscInt n;
2386 
2387     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2388     recompute_zerodiag = PETSC_FALSE;
2389     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2390     if (n) {
2391       has_null_pressures = PETSC_FALSE;
2392       have_null = PETSC_FALSE;
2393     }
2394   }
2395 
2396   /* final check for null pressures */
2397   if (zerodiag && pressures) {
2398     PetscInt nz,np;
2399     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2400     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2401     if (nz != np) have_null = PETSC_FALSE;
2402   }
2403 
2404   if (recompute_zerodiag) {
2405     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2406     if (pcbddc->benign_n == 1) {
2407       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2408       zerodiag = zerodiag_subs[0];
2409     } else {
2410       PetscInt i,nzn,*new_idxs;
2411 
2412       nzn = 0;
2413       for (i=0;i<pcbddc->benign_n;i++) {
2414         PetscInt ns;
2415         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2416         nzn += ns;
2417       }
2418       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2419       nzn = 0;
2420       for (i=0;i<pcbddc->benign_n;i++) {
2421         PetscInt ns,*idxs;
2422         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2423         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2424         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2425         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2426         nzn += ns;
2427       }
2428       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2429       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2430     }
2431     have_null = PETSC_FALSE;
2432   }
2433 
2434   /* Prepare matrix to compute no-net-flux */
2435   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2436     Mat                    A,loc_divudotp;
2437     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2438     IS                     row,col,isused = NULL;
2439     PetscInt               M,N,n,st,n_isused;
2440 
2441     if (pressures) {
2442       isused = pressures;
2443     } else {
2444       isused = zerodiag;
2445     }
2446     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2447     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2448     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2449     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");
2450     n_isused = 0;
2451     if (isused) {
2452       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2453     }
2454     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2455     st = st-n_isused;
2456     if (n) {
2457       const PetscInt *gidxs;
2458 
2459       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2460       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2461       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2462       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2463       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2464       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2465     } else {
2466       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2467       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2468       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2469     }
2470     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2471     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2472     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2473     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2474     ierr = ISDestroy(&row);CHKERRQ(ierr);
2475     ierr = ISDestroy(&col);CHKERRQ(ierr);
2476     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2477     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2478     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2479     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2480     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2481     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2482     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2483     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2484     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2485     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2486   }
2487 
2488   /* change of basis and p0 dofs */
2489   if (has_null_pressures) {
2490     IS             zerodiagc;
2491     const PetscInt *idxs,*idxsc;
2492     PetscInt       i,s,*nnz;
2493 
2494     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2495     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2496     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2497     /* local change of basis for pressures */
2498     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2499     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2500     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2501     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2502     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2503     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2504     for (i=0;i<pcbddc->benign_n;i++) {
2505       PetscInt nzs,j;
2506 
2507       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2508       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2509       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2510       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2511       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2512     }
2513     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2514     ierr = PetscFree(nnz);CHKERRQ(ierr);
2515     /* set identity on velocities */
2516     for (i=0;i<n-nz;i++) {
2517       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2518     }
2519     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2520     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2521     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2522     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2523     /* set change on pressures */
2524     for (s=0;s<pcbddc->benign_n;s++) {
2525       PetscScalar *array;
2526       PetscInt    nzs;
2527 
2528       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2529       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2530       for (i=0;i<nzs-1;i++) {
2531         PetscScalar vals[2];
2532         PetscInt    cols[2];
2533 
2534         cols[0] = idxs[i];
2535         cols[1] = idxs[nzs-1];
2536         vals[0] = 1.;
2537         vals[1] = 1.;
2538         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2539       }
2540       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2541       for (i=0;i<nzs-1;i++) array[i] = -1.;
2542       array[nzs-1] = 1.;
2543       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2544       /* store local idxs for p0 */
2545       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2546       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2547       ierr = PetscFree(array);CHKERRQ(ierr);
2548     }
2549     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2550     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2551     /* project if needed */
2552     if (pcbddc->benign_change_explicit) {
2553       Mat M;
2554 
2555       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2556       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2557       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2558       ierr = MatDestroy(&M);CHKERRQ(ierr);
2559     }
2560     /* store global idxs for p0 */
2561     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2562   }
2563   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2564   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2565 
2566   /* determines if the coarse solver will be singular or not */
2567   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2568   /* determines if the problem has subdomains with 0 pressure block */
2569   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2570   *zerodiaglocal = zerodiag;
2571   PetscFunctionReturn(0);
2572 }
2573 
2574 #undef __FUNCT__
2575 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
2576 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2577 {
2578   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2579   PetscScalar    *array;
2580   PetscErrorCode ierr;
2581 
2582   PetscFunctionBegin;
2583   if (!pcbddc->benign_sf) {
2584     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2585     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2586   }
2587   if (get) {
2588     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2589     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2590     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2591     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2592   } else {
2593     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2594     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2595     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2596     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2597   }
2598   PetscFunctionReturn(0);
2599 }
2600 
2601 #undef __FUNCT__
2602 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
2603 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2604 {
2605   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2606   PetscErrorCode ierr;
2607 
2608   PetscFunctionBegin;
2609   /* TODO: add error checking
2610     - avoid nested pop (or push) calls.
2611     - cannot push before pop.
2612     - cannot call this if pcbddc->local_mat is NULL
2613   */
2614   if (!pcbddc->benign_n) {
2615     PetscFunctionReturn(0);
2616   }
2617   if (pop) {
2618     if (pcbddc->benign_change_explicit) {
2619       IS       is_p0;
2620       MatReuse reuse;
2621 
2622       /* extract B_0 */
2623       reuse = MAT_INITIAL_MATRIX;
2624       if (pcbddc->benign_B0) {
2625         reuse = MAT_REUSE_MATRIX;
2626       }
2627       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2628       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2629       /* remove rows and cols from local problem */
2630       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2631       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2632       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2633       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2634     } else {
2635       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2636       PetscScalar *vals;
2637       PetscInt    i,n,*idxs_ins;
2638 
2639       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2640       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2641       if (!pcbddc->benign_B0) {
2642         PetscInt *nnz;
2643         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2644         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2645         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2646         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2647         for (i=0;i<pcbddc->benign_n;i++) {
2648           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2649           nnz[i] = n - nnz[i];
2650         }
2651         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2652         ierr = PetscFree(nnz);CHKERRQ(ierr);
2653       }
2654 
2655       for (i=0;i<pcbddc->benign_n;i++) {
2656         PetscScalar *array;
2657         PetscInt    *idxs,j,nz,cum;
2658 
2659         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2660         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2661         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2662         for (j=0;j<nz;j++) vals[j] = 1.;
2663         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2664         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2665         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2666         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2667         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2668         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2669         cum = 0;
2670         for (j=0;j<n;j++) {
2671           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2672             vals[cum] = array[j];
2673             idxs_ins[cum] = j;
2674             cum++;
2675           }
2676         }
2677         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2678         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2679         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2680       }
2681       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2682       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2683       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2684     }
2685   } else { /* push */
2686     if (pcbddc->benign_change_explicit) {
2687       PetscInt i;
2688 
2689       for (i=0;i<pcbddc->benign_n;i++) {
2690         PetscScalar *B0_vals;
2691         PetscInt    *B0_cols,B0_ncol;
2692 
2693         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2694         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2695         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2696         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2697         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2698       }
2699       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2700       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2701     } else {
2702       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2703     }
2704   }
2705   PetscFunctionReturn(0);
2706 }
2707 
2708 #undef __FUNCT__
2709 #define __FUNCT__ "PCBDDCAdaptiveSelection"
2710 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2711 {
2712   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2713   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2714   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2715   PetscBLASInt    *B_iwork,*B_ifail;
2716   PetscScalar     *work,lwork;
2717   PetscScalar     *St,*S,*eigv;
2718   PetscScalar     *Sarray,*Starray;
2719   PetscReal       *eigs,thresh;
2720   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2721   PetscBool       allocated_S_St;
2722 #if defined(PETSC_USE_COMPLEX)
2723   PetscReal       *rwork;
2724 #endif
2725   PetscErrorCode  ierr;
2726 
2727   PetscFunctionBegin;
2728   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2729   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2730   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);
2731 
2732   if (pcbddc->dbg_flag) {
2733     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2734     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2735     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2736     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2737   }
2738 
2739   if (pcbddc->dbg_flag) {
2740     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2741   }
2742 
2743   /* max size of subsets */
2744   mss = 0;
2745   for (i=0;i<sub_schurs->n_subs;i++) {
2746     PetscInt subset_size;
2747 
2748     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2749     mss = PetscMax(mss,subset_size);
2750   }
2751 
2752   /* min/max and threshold */
2753   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2754   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2755   nmax = PetscMax(nmin,nmax);
2756   allocated_S_St = PETSC_FALSE;
2757   if (nmin) {
2758     allocated_S_St = PETSC_TRUE;
2759   }
2760 
2761   /* allocate lapack workspace */
2762   cum = cum2 = 0;
2763   maxneigs = 0;
2764   for (i=0;i<sub_schurs->n_subs;i++) {
2765     PetscInt n,subset_size;
2766 
2767     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2768     n = PetscMin(subset_size,nmax);
2769     cum += subset_size;
2770     cum2 += subset_size*n;
2771     maxneigs = PetscMax(maxneigs,n);
2772   }
2773   if (mss) {
2774     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2775       PetscBLASInt B_itype = 1;
2776       PetscBLASInt B_N = mss;
2777       PetscReal    zero = 0.0;
2778       PetscReal    eps = 0.0; /* dlamch? */
2779 
2780       B_lwork = -1;
2781       S = NULL;
2782       St = NULL;
2783       eigs = NULL;
2784       eigv = NULL;
2785       B_iwork = NULL;
2786       B_ifail = NULL;
2787 #if defined(PETSC_USE_COMPLEX)
2788       rwork = NULL;
2789 #endif
2790       thresh = 1.0;
2791       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2792 #if defined(PETSC_USE_COMPLEX)
2793       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));
2794 #else
2795       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));
2796 #endif
2797       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2798       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2799     } else {
2800         /* TODO */
2801     }
2802   } else {
2803     lwork = 0;
2804   }
2805 
2806   nv = 0;
2807   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) */
2808     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2809   }
2810   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2811   if (allocated_S_St) {
2812     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2813   }
2814   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2815 #if defined(PETSC_USE_COMPLEX)
2816   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2817 #endif
2818   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2819                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2820                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2821                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2822                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2823   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2824 
2825   maxneigs = 0;
2826   cum = cumarray = 0;
2827   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2828   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2829   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2830     const PetscInt *idxs;
2831 
2832     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2833     for (cum=0;cum<nv;cum++) {
2834       pcbddc->adaptive_constraints_n[cum] = 1;
2835       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2836       pcbddc->adaptive_constraints_data[cum] = 1.0;
2837       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2838       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2839     }
2840     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2841   }
2842 
2843   if (mss) { /* multilevel */
2844     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2845     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2846   }
2847 
2848   thresh = pcbddc->adaptive_threshold;
2849   for (i=0;i<sub_schurs->n_subs;i++) {
2850     const PetscInt *idxs;
2851     PetscReal      upper,lower;
2852     PetscInt       j,subset_size,eigs_start = 0;
2853     PetscBLASInt   B_N;
2854     PetscBool      same_data = PETSC_FALSE;
2855 
2856     if (pcbddc->use_deluxe_scaling) {
2857       upper = PETSC_MAX_REAL;
2858       lower = thresh;
2859     } else {
2860       upper = 1./thresh;
2861       lower = 0.;
2862     }
2863     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2864     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2865     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2866     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2867       if (sub_schurs->is_hermitian) {
2868         PetscInt j,k;
2869         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2870           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2871           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2872         }
2873         for (j=0;j<subset_size;j++) {
2874           for (k=j;k<subset_size;k++) {
2875             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2876             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2877           }
2878         }
2879       } else {
2880         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2881         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2882       }
2883     } else {
2884       S = Sarray + cumarray;
2885       St = Starray + cumarray;
2886     }
2887     /* see if we can save some work */
2888     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2889       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2890     }
2891 
2892     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2893       B_neigs = 0;
2894     } else {
2895       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2896         PetscBLASInt B_itype = 1;
2897         PetscBLASInt B_IL, B_IU;
2898         PetscReal    eps = -1.0; /* dlamch? */
2899         PetscInt     nmin_s;
2900         PetscBool    compute_range = PETSC_FALSE;
2901 
2902         if (pcbddc->dbg_flag) {
2903           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]]);
2904         }
2905 
2906         compute_range = PETSC_FALSE;
2907         if (thresh > 1.+PETSC_SMALL && !same_data) {
2908           compute_range = PETSC_TRUE;
2909         }
2910 
2911         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2912         if (compute_range) {
2913 
2914           /* ask for eigenvalues larger than thresh */
2915 #if defined(PETSC_USE_COMPLEX)
2916           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));
2917 #else
2918           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));
2919 #endif
2920         } else if (!same_data) {
2921           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2922           B_IL = 1;
2923 #if defined(PETSC_USE_COMPLEX)
2924           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));
2925 #else
2926           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));
2927 #endif
2928         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2929           PetscInt k;
2930           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
2931           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
2932           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
2933           nmin = nmax;
2934           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2935           for (k=0;k<nmax;k++) {
2936             eigs[k] = 1./PETSC_SMALL;
2937             eigv[k*(subset_size+1)] = 1.0;
2938           }
2939         }
2940         ierr = PetscFPTrapPop();CHKERRQ(ierr);
2941         if (B_ierr) {
2942           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
2943           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);
2944           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);
2945         }
2946 
2947         if (B_neigs > nmax) {
2948           if (pcbddc->dbg_flag) {
2949             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
2950           }
2951           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
2952           B_neigs = nmax;
2953         }
2954 
2955         nmin_s = PetscMin(nmin,B_N);
2956         if (B_neigs < nmin_s) {
2957           PetscBLASInt B_neigs2;
2958 
2959           if (pcbddc->use_deluxe_scaling) {
2960             B_IL = B_N - nmin_s + 1;
2961             B_IU = B_N - B_neigs;
2962           } else {
2963             B_IL = B_neigs + 1;
2964             B_IU = nmin_s;
2965           }
2966           if (pcbddc->dbg_flag) {
2967             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);
2968           }
2969           if (sub_schurs->is_hermitian) {
2970             PetscInt j,k;
2971             for (j=0;j<subset_size;j++) {
2972               for (k=j;k<subset_size;k++) {
2973                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2974                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2975               }
2976             }
2977           } else {
2978             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2979             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2980           }
2981           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2982 #if defined(PETSC_USE_COMPLEX)
2983           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));
2984 #else
2985           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));
2986 #endif
2987           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2988           B_neigs += B_neigs2;
2989         }
2990         if (B_ierr) {
2991           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
2992           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);
2993           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);
2994         }
2995         if (pcbddc->dbg_flag) {
2996           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
2997           for (j=0;j<B_neigs;j++) {
2998             if (eigs[j] == 0.0) {
2999               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3000             } else {
3001               if (pcbddc->use_deluxe_scaling) {
3002                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3003               } else {
3004                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3005               }
3006             }
3007           }
3008         }
3009       } else {
3010           /* TODO */
3011       }
3012     }
3013     /* change the basis back to the original one */
3014     if (sub_schurs->change) {
3015       Mat change,phi,phit;
3016 
3017       if (pcbddc->dbg_flag > 1) {
3018         PetscInt ii;
3019         for (ii=0;ii<B_neigs;ii++) {
3020           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3021           for (j=0;j<B_N;j++) {
3022 #if defined(PETSC_USE_COMPLEX)
3023             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3024             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3025             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3026 #else
3027             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3028 #endif
3029           }
3030         }
3031       }
3032       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3033       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3034       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3035       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3036       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3037       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3038     }
3039     maxneigs = PetscMax(B_neigs,maxneigs);
3040     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3041     if (B_neigs) {
3042       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);
3043 
3044       if (pcbddc->dbg_flag > 1) {
3045         PetscInt ii;
3046         for (ii=0;ii<B_neigs;ii++) {
3047           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3048           for (j=0;j<B_N;j++) {
3049 #if defined(PETSC_USE_COMPLEX)
3050             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3051             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3052             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3053 #else
3054             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3055 #endif
3056           }
3057         }
3058       }
3059       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3060       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3061       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3062       cum++;
3063     }
3064     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3065     /* shift for next computation */
3066     cumarray += subset_size*subset_size;
3067   }
3068   if (pcbddc->dbg_flag) {
3069     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3070   }
3071 
3072   if (mss) {
3073     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3074     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3075     /* destroy matrices (junk) */
3076     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3077     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3078   }
3079   if (allocated_S_St) {
3080     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3081   }
3082   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3083 #if defined(PETSC_USE_COMPLEX)
3084   ierr = PetscFree(rwork);CHKERRQ(ierr);
3085 #endif
3086   if (pcbddc->dbg_flag) {
3087     PetscInt maxneigs_r;
3088     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3089     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3090   }
3091   PetscFunctionReturn(0);
3092 }
3093 
3094 #undef __FUNCT__
3095 #define __FUNCT__ "PCBDDCSetUpSolvers"
3096 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3097 {
3098   PetscScalar    *coarse_submat_vals;
3099   PetscErrorCode ierr;
3100 
3101   PetscFunctionBegin;
3102   /* Setup local scatters R_to_B and (optionally) R_to_D */
3103   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3104   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3105 
3106   /* Setup local neumann solver ksp_R */
3107   /* PCBDDCSetUpLocalScatters should be called first! */
3108   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3109 
3110   /*
3111      Setup local correction and local part of coarse basis.
3112      Gives back the dense local part of the coarse matrix in column major ordering
3113   */
3114   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3115 
3116   /* Compute total number of coarse nodes and setup coarse solver */
3117   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3118 
3119   /* free */
3120   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3121   PetscFunctionReturn(0);
3122 }
3123 
3124 #undef __FUNCT__
3125 #define __FUNCT__ "PCBDDCResetCustomization"
3126 PetscErrorCode PCBDDCResetCustomization(PC pc)
3127 {
3128   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3129   PetscErrorCode ierr;
3130 
3131   PetscFunctionBegin;
3132   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3133   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3134   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3135   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3136   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3137   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3138   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3139   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3140   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3141   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3142   PetscFunctionReturn(0);
3143 }
3144 
3145 #undef __FUNCT__
3146 #define __FUNCT__ "PCBDDCResetTopography"
3147 PetscErrorCode PCBDDCResetTopography(PC pc)
3148 {
3149   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3150   PetscInt       i;
3151   PetscErrorCode ierr;
3152 
3153   PetscFunctionBegin;
3154   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3155   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3156   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3157   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3158   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3159   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3160   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3161   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3162   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3163   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3164   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
3165   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
3166   for (i=0;i<pcbddc->n_local_subs;i++) {
3167     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3168   }
3169   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3170   if (pcbddc->sub_schurs) {
3171     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
3172   }
3173   pcbddc->graphanalyzed        = PETSC_FALSE;
3174   pcbddc->recompute_topography = PETSC_TRUE;
3175   PetscFunctionReturn(0);
3176 }
3177 
3178 #undef __FUNCT__
3179 #define __FUNCT__ "PCBDDCResetSolvers"
3180 PetscErrorCode PCBDDCResetSolvers(PC pc)
3181 {
3182   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3183   PetscErrorCode ierr;
3184 
3185   PetscFunctionBegin;
3186   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3187   if (pcbddc->coarse_phi_B) {
3188     PetscScalar *array;
3189     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3190     ierr = PetscFree(array);CHKERRQ(ierr);
3191   }
3192   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3193   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3194   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3195   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3196   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3197   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3198   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3199   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3200   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3201   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3202   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3203   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3204   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3205   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3206   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
3207   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
3208   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
3209   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3210   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3211   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3212   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3213   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3214   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3215   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3216   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3217   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3218   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3219   if (pcbddc->benign_zerodiag_subs) {
3220     PetscInt i;
3221     for (i=0;i<pcbddc->benign_n;i++) {
3222       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3223     }
3224     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3225   }
3226   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3227   PetscFunctionReturn(0);
3228 }
3229 
3230 #undef __FUNCT__
3231 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
3232 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3233 {
3234   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3235   PC_IS          *pcis = (PC_IS*)pc->data;
3236   VecType        impVecType;
3237   PetscInt       n_constraints,n_R,old_size;
3238   PetscErrorCode ierr;
3239 
3240   PetscFunctionBegin;
3241   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3242   n_R = pcis->n - pcbddc->n_vertices;
3243   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3244   /* local work vectors (try to avoid unneeded work)*/
3245   /* R nodes */
3246   old_size = -1;
3247   if (pcbddc->vec1_R) {
3248     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3249   }
3250   if (n_R != old_size) {
3251     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3252     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3253     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3254     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3255     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3256     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3257   }
3258   /* local primal dofs */
3259   old_size = -1;
3260   if (pcbddc->vec1_P) {
3261     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3262   }
3263   if (pcbddc->local_primal_size != old_size) {
3264     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3265     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3266     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3267     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3268   }
3269   /* local explicit constraints */
3270   old_size = -1;
3271   if (pcbddc->vec1_C) {
3272     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3273   }
3274   if (n_constraints && n_constraints != old_size) {
3275     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3276     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3277     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3278     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3279   }
3280   PetscFunctionReturn(0);
3281 }
3282 
3283 #undef __FUNCT__
3284 #define __FUNCT__ "PCBDDCSetUpCorrection"
3285 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3286 {
3287   PetscErrorCode  ierr;
3288   /* pointers to pcis and pcbddc */
3289   PC_IS*          pcis = (PC_IS*)pc->data;
3290   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3291   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3292   /* submatrices of local problem */
3293   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3294   /* submatrices of local coarse problem */
3295   Mat             S_VV,S_CV,S_VC,S_CC;
3296   /* working matrices */
3297   Mat             C_CR;
3298   /* additional working stuff */
3299   PC              pc_R;
3300   Mat             F;
3301   Vec             dummy_vec;
3302   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3303   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3304   PetscScalar     *work;
3305   PetscInt        *idx_V_B;
3306   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3307   PetscInt        i,n_R,n_D,n_B;
3308 
3309   /* some shortcuts to scalars */
3310   PetscScalar     one=1.0,m_one=-1.0;
3311 
3312   PetscFunctionBegin;
3313   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");
3314 
3315   /* Set Non-overlapping dimensions */
3316   n_vertices = pcbddc->n_vertices;
3317   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3318   n_B = pcis->n_B;
3319   n_D = pcis->n - n_B;
3320   n_R = pcis->n - n_vertices;
3321 
3322   /* vertices in boundary numbering */
3323   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3324   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3325   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3326 
3327   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3328   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3329   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3330   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3331   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3332   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3333   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3334   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3335   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3336   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3337 
3338   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3339   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3340   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3341   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3342   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3343   lda_rhs = n_R;
3344   need_benign_correction = PETSC_FALSE;
3345   if (isLU || isILU || isCHOL) {
3346     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3347   } else if (sub_schurs && sub_schurs->reuse_solver) {
3348     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3349     MatFactorType      type;
3350 
3351     F = reuse_solver->F;
3352     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3353     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3354     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3355     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3356   } else {
3357     F = NULL;
3358   }
3359 
3360   /* allocate workspace */
3361   n = 0;
3362   if (n_constraints) {
3363     n += lda_rhs*n_constraints;
3364   }
3365   if (n_vertices) {
3366     n = PetscMax(2*lda_rhs*n_vertices,n);
3367     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3368   }
3369   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3370 
3371   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3372   dummy_vec = NULL;
3373   if (need_benign_correction && lda_rhs != n_R && F) {
3374     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3375   }
3376 
3377   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3378   if (n_constraints) {
3379     Mat         M1,M2,M3,C_B;
3380     IS          is_aux;
3381     PetscScalar *array,*array2;
3382 
3383     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3384     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3385 
3386     /* Extract constraints on R nodes: C_{CR}  */
3387     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3388     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3389     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3390 
3391     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3392     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3393     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3394     for (i=0;i<n_constraints;i++) {
3395       const PetscScalar *row_cmat_values;
3396       const PetscInt    *row_cmat_indices;
3397       PetscInt          size_of_constraint,j;
3398 
3399       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3400       for (j=0;j<size_of_constraint;j++) {
3401         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3402       }
3403       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3404     }
3405     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3406     if (F) {
3407       Mat B;
3408 
3409       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3410       if (need_benign_correction) {
3411         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3412 
3413         /* rhs is already zero on interior dofs, no need to change the rhs */
3414         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3415       }
3416       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3417       if (need_benign_correction) {
3418         PetscScalar        *marr;
3419         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3420 
3421         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3422         if (lda_rhs != n_R) {
3423           for (i=0;i<n_constraints;i++) {
3424             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3425             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3426             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3427           }
3428         } else {
3429           for (i=0;i<n_constraints;i++) {
3430             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3431             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3432             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3433           }
3434         }
3435         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3436       }
3437       ierr = MatDestroy(&B);CHKERRQ(ierr);
3438     } else {
3439       PetscScalar *marr;
3440 
3441       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3442       for (i=0;i<n_constraints;i++) {
3443         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3444         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3445         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3446         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3447         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3448       }
3449       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3450     }
3451     if (!pcbddc->switch_static) {
3452       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3453       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3454       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3455       for (i=0;i<n_constraints;i++) {
3456         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3457         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3458         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3459         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3460         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3461         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3462       }
3463       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3464       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3465       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3466     } else {
3467       if (lda_rhs != n_R) {
3468         IS dummy;
3469 
3470         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3471         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3472         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3473       } else {
3474         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3475         pcbddc->local_auxmat2 = local_auxmat2_R;
3476       }
3477       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3478     }
3479     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3480     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3481     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3482     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3483     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3484     if (isCHOL) {
3485       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3486     } else {
3487       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3488     }
3489     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3490     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3491     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3492     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3493     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3494     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3495     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3496     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3497     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3498     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3499   }
3500 
3501   /* Get submatrices from subdomain matrix */
3502   if (n_vertices) {
3503     IS is_aux;
3504 
3505     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3506       IS tis;
3507 
3508       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3509       ierr = ISSort(tis);CHKERRQ(ierr);
3510       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3511       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3512     } else {
3513       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3514     }
3515     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3516     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3517     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3518     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3519   }
3520 
3521   /* Matrix of coarse basis functions (local) */
3522   if (pcbddc->coarse_phi_B) {
3523     PetscInt on_B,on_primal,on_D=n_D;
3524     if (pcbddc->coarse_phi_D) {
3525       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3526     }
3527     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3528     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3529       PetscScalar *marray;
3530 
3531       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3532       ierr = PetscFree(marray);CHKERRQ(ierr);
3533       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3534       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3535       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3536       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3537     }
3538   }
3539 
3540   if (!pcbddc->coarse_phi_B) {
3541     PetscScalar *marray;
3542 
3543     n = n_B*pcbddc->local_primal_size;
3544     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3545       n += n_D*pcbddc->local_primal_size;
3546     }
3547     if (!pcbddc->symmetric_primal) {
3548       n *= 2;
3549     }
3550     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
3551     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3552     n = n_B*pcbddc->local_primal_size;
3553     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3554       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3555       n += n_D*pcbddc->local_primal_size;
3556     }
3557     if (!pcbddc->symmetric_primal) {
3558       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3559       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3560         n = n_B*pcbddc->local_primal_size;
3561         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3562       }
3563     } else {
3564       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3565       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3566       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3567         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3568         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3569       }
3570     }
3571   }
3572 
3573   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3574   p0_lidx_I = NULL;
3575   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3576     const PetscInt *idxs;
3577 
3578     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3579     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3580     for (i=0;i<pcbddc->benign_n;i++) {
3581       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3582     }
3583     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3584   }
3585 
3586   /* vertices */
3587   if (n_vertices) {
3588 
3589     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3590 
3591     if (n_R) {
3592       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3593       PetscBLASInt B_N,B_one = 1;
3594       PetscScalar  *x,*y;
3595       PetscBool    isseqaij;
3596 
3597       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3598       if (need_benign_correction) {
3599         ISLocalToGlobalMapping RtoN;
3600         IS                     is_p0;
3601         PetscInt               *idxs_p0,n;
3602 
3603         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3604         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3605         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3606         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);
3607         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3608         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3609         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3610         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3611       }
3612 
3613       if (lda_rhs == n_R) {
3614         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3615       } else {
3616         PetscScalar    *av,*array;
3617         const PetscInt *xadj,*adjncy;
3618         PetscInt       n;
3619         PetscBool      flg_row;
3620 
3621         array = work+lda_rhs*n_vertices;
3622         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3623         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3624         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3625         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3626         for (i=0;i<n;i++) {
3627           PetscInt j;
3628           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3629         }
3630         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3631         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3632         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3633       }
3634       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3635       if (need_benign_correction) {
3636         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3637         PetscScalar        *marr;
3638 
3639         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3640         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3641 
3642                | 0 0  0 | (V)
3643            L = | 0 0 -1 | (P-p0)
3644                | 0 0 -1 | (p0)
3645 
3646         */
3647         for (i=0;i<reuse_solver->benign_n;i++) {
3648           const PetscScalar *vals;
3649           const PetscInt    *idxs,*idxs_zero;
3650           PetscInt          n,j,nz;
3651 
3652           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3653           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3654           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3655           for (j=0;j<n;j++) {
3656             PetscScalar val = vals[j];
3657             PetscInt    k,col = idxs[j];
3658             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3659           }
3660           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3661           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3662         }
3663         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3664       }
3665       if (F) {
3666         /* need to correct the rhs */
3667         if (need_benign_correction) {
3668           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3669           PetscScalar        *marr;
3670 
3671           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3672           if (lda_rhs != n_R) {
3673             for (i=0;i<n_vertices;i++) {
3674               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3675               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3676               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3677             }
3678           } else {
3679             for (i=0;i<n_vertices;i++) {
3680               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3681               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3682               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3683             }
3684           }
3685           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3686         }
3687         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3688         /* need to correct the solution */
3689         if (need_benign_correction) {
3690           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3691           PetscScalar        *marr;
3692 
3693           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3694           if (lda_rhs != n_R) {
3695             for (i=0;i<n_vertices;i++) {
3696               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3697               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3698               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3699             }
3700           } else {
3701             for (i=0;i<n_vertices;i++) {
3702               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3703               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3704               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3705             }
3706           }
3707           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3708         }
3709       } else {
3710         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3711         for (i=0;i<n_vertices;i++) {
3712           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3713           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3714           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3715           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3716           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3717         }
3718         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3719       }
3720       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3721       /* S_VV and S_CV */
3722       if (n_constraints) {
3723         Mat B;
3724 
3725         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3726         for (i=0;i<n_vertices;i++) {
3727           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3728           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3729           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3730           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3731           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3732           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3733         }
3734         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3735         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3736         ierr = MatDestroy(&B);CHKERRQ(ierr);
3737         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3738         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3739         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3740         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3741         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3742         ierr = MatDestroy(&B);CHKERRQ(ierr);
3743       }
3744       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3745       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3746         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3747       }
3748       if (lda_rhs != n_R) {
3749         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3750         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3751         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3752       }
3753       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3754       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3755       if (need_benign_correction) {
3756         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3757         PetscScalar      *marr,*sums;
3758 
3759         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3760         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3761         for (i=0;i<reuse_solver->benign_n;i++) {
3762           const PetscScalar *vals;
3763           const PetscInt    *idxs,*idxs_zero;
3764           PetscInt          n,j,nz;
3765 
3766           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3767           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3768           for (j=0;j<n_vertices;j++) {
3769             PetscInt k;
3770             sums[j] = 0.;
3771             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3772           }
3773           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3774           for (j=0;j<n;j++) {
3775             PetscScalar val = vals[j];
3776             PetscInt k;
3777             for (k=0;k<n_vertices;k++) {
3778               marr[idxs[j]+k*n_vertices] += val*sums[k];
3779             }
3780           }
3781           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3782           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3783         }
3784         ierr = PetscFree(sums);CHKERRQ(ierr);
3785         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3786         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3787       }
3788       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3789       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3790       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3791       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3792       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3793       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3794       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3795       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3796       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3797     } else {
3798       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3799     }
3800     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3801 
3802     /* coarse basis functions */
3803     for (i=0;i<n_vertices;i++) {
3804       PetscScalar *y;
3805 
3806       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3807       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3808       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3809       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3810       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3811       y[n_B*i+idx_V_B[i]] = 1.0;
3812       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3813       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3814 
3815       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3816         PetscInt j;
3817 
3818         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3819         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3820         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3821         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3822         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3823         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3824         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3825       }
3826       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3827     }
3828     /* if n_R == 0 the object is not destroyed */
3829     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3830   }
3831   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3832 
3833   if (n_constraints) {
3834     Mat B;
3835 
3836     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3837     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3838     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3839     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3840     if (n_vertices) {
3841       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3842         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3843       } else {
3844         Mat S_VCt;
3845 
3846         if (lda_rhs != n_R) {
3847           ierr = MatDestroy(&B);CHKERRQ(ierr);
3848           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3849           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3850         }
3851         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3852         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3853         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3854       }
3855     }
3856     ierr = MatDestroy(&B);CHKERRQ(ierr);
3857     /* coarse basis functions */
3858     for (i=0;i<n_constraints;i++) {
3859       PetscScalar *y;
3860 
3861       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3862       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3863       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3864       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3865       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3866       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3867       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3868       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3869         PetscInt j;
3870 
3871         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3872         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3873         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3874         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3875         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3876         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3877         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3878       }
3879       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3880     }
3881   }
3882   if (n_constraints) {
3883     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3884   }
3885   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3886 
3887   /* coarse matrix entries relative to B_0 */
3888   if (pcbddc->benign_n) {
3889     Mat         B0_B,B0_BPHI;
3890     IS          is_dummy;
3891     PetscScalar *data;
3892     PetscInt    j;
3893 
3894     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3895     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3896     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3897     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3898     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3899     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3900     for (j=0;j<pcbddc->benign_n;j++) {
3901       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3902       for (i=0;i<pcbddc->local_primal_size;i++) {
3903         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3904         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3905       }
3906     }
3907     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3908     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3909     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3910   }
3911 
3912   /* compute other basis functions for non-symmetric problems */
3913   if (!pcbddc->symmetric_primal) {
3914     Mat         B_V=NULL,B_C=NULL;
3915     PetscScalar *marray;
3916 
3917     if (n_constraints) {
3918       Mat S_CCT,C_CRT;
3919 
3920       ierr = MatTranspose(C_CR,MAT_INPLACE_MATRIX,&C_CRT);CHKERRQ(ierr);
3921       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3922       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3923       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3924       if (n_vertices) {
3925         Mat S_VCT;
3926 
3927         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3928         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3929         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
3930       }
3931       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
3932     } else {
3933       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
3934     }
3935     if (n_vertices && n_R) {
3936       PetscScalar    *av,*marray;
3937       const PetscInt *xadj,*adjncy;
3938       PetscInt       n;
3939       PetscBool      flg_row;
3940 
3941       /* B_V = B_V - A_VR^T */
3942       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3943       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3944       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
3945       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3946       for (i=0;i<n;i++) {
3947         PetscInt j;
3948         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
3949       }
3950       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3951       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3952       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
3953     }
3954 
3955     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
3956     ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3957     for (i=0;i<n_vertices;i++) {
3958       ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
3959       ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3960       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3961       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3962       ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3963     }
3964     ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3965     if (B_C) {
3966       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
3967       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
3968         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
3969         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3970         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3971         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3972         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3973       }
3974       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
3975     }
3976     /* coarse basis functions */
3977     for (i=0;i<pcbddc->local_primal_size;i++) {
3978       PetscScalar *y;
3979 
3980       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
3981       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
3982       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3983       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3984       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3985       if (i<n_vertices) {
3986         y[n_B*i+idx_V_B[i]] = 1.0;
3987       }
3988       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
3989       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3990 
3991       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3992         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
3993         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3994         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3995         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3996         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3997         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
3998       }
3999       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4000     }
4001     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4002     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4003   }
4004   /* free memory */
4005   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4006   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4007   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4008   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4009   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4010   ierr = PetscFree(work);CHKERRQ(ierr);
4011   if (n_vertices) {
4012     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4013   }
4014   if (n_constraints) {
4015     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4016   }
4017   /* Checking coarse_sub_mat and coarse basis functios */
4018   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4019   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4020   if (pcbddc->dbg_flag) {
4021     Mat         coarse_sub_mat;
4022     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4023     Mat         coarse_phi_D,coarse_phi_B;
4024     Mat         coarse_psi_D,coarse_psi_B;
4025     Mat         A_II,A_BB,A_IB,A_BI;
4026     Mat         C_B,CPHI;
4027     IS          is_dummy;
4028     Vec         mones;
4029     MatType     checkmattype=MATSEQAIJ;
4030     PetscReal   real_value;
4031 
4032     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4033       Mat A;
4034       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4035       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4036       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4037       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4038       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4039       ierr = MatDestroy(&A);CHKERRQ(ierr);
4040     } else {
4041       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4042       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4043       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4044       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4045     }
4046     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4047     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4048     if (!pcbddc->symmetric_primal) {
4049       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4050       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4051     }
4052     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4053 
4054     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4055     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4056     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4057     if (!pcbddc->symmetric_primal) {
4058       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4059       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4060       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4061       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4062       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4063       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4064       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4065       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4066       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4067       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4068       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4069       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4070     } else {
4071       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4072       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4073       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4074       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4075       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4076       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4077       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4078       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4079     }
4080     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4081     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4082     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4083     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4084     if (pcbddc->benign_n) {
4085       Mat         B0_B,B0_BPHI;
4086       PetscScalar *data,*data2;
4087       PetscInt    j;
4088 
4089       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4090       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4091       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4092       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4093       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4094       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4095       for (j=0;j<pcbddc->benign_n;j++) {
4096         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4097         for (i=0;i<pcbddc->local_primal_size;i++) {
4098           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4099           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4100         }
4101       }
4102       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4103       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4104       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4105       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4106       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4107     }
4108 #if 0
4109   {
4110     PetscViewer viewer;
4111     char filename[256];
4112     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4113     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4114     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4115     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4116     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4117     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4118     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4119     if (save_change) {
4120       Mat phi_B;
4121       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4122       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4123       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4124       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4125     } else {
4126       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4127       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4128     }
4129     if (pcbddc->coarse_phi_D) {
4130       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4131       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4132     }
4133     if (pcbddc->coarse_psi_B) {
4134       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4135       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4136     }
4137     if (pcbddc->coarse_psi_D) {
4138       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4139       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4140     }
4141     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4142   }
4143 #endif
4144     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4145     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4146     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4147     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4148 
4149     /* check constraints */
4150     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4151     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4152     if (!pcbddc->benign_n) { /* TODO: add benign case */
4153       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4154     } else {
4155       PetscScalar *data;
4156       Mat         tmat;
4157       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4158       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4159       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4160       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4161       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4162     }
4163     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4164     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4165     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4166     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4167     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4168     if (!pcbddc->symmetric_primal) {
4169       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4170       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4171       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4172       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4173       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4174     }
4175     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4176     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4177     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4178     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4179     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4180     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4181     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4182     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4183     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4184     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4185     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4186     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4187     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4188     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4189     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4190     if (!pcbddc->symmetric_primal) {
4191       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4192       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4193     }
4194     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4195   }
4196   /* get back data */
4197   *coarse_submat_vals_n = coarse_submat_vals;
4198   PetscFunctionReturn(0);
4199 }
4200 
4201 #undef __FUNCT__
4202 #define __FUNCT__ "MatGetSubMatrixUnsorted"
4203 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4204 {
4205   Mat            *work_mat;
4206   IS             isrow_s,iscol_s;
4207   PetscBool      rsorted,csorted;
4208   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4209   PetscErrorCode ierr;
4210 
4211   PetscFunctionBegin;
4212   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4213   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4214   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4215   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4216 
4217   if (!rsorted) {
4218     const PetscInt *idxs;
4219     PetscInt *idxs_sorted,i;
4220 
4221     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4222     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4223     for (i=0;i<rsize;i++) {
4224       idxs_perm_r[i] = i;
4225     }
4226     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4227     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4228     for (i=0;i<rsize;i++) {
4229       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4230     }
4231     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4232     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4233   } else {
4234     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4235     isrow_s = isrow;
4236   }
4237 
4238   if (!csorted) {
4239     if (isrow == iscol) {
4240       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4241       iscol_s = isrow_s;
4242     } else {
4243       const PetscInt *idxs;
4244       PetscInt       *idxs_sorted,i;
4245 
4246       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4247       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4248       for (i=0;i<csize;i++) {
4249         idxs_perm_c[i] = i;
4250       }
4251       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4252       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4253       for (i=0;i<csize;i++) {
4254         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4255       }
4256       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4257       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4258     }
4259   } else {
4260     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4261     iscol_s = iscol;
4262   }
4263 
4264   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4265 
4266   if (!rsorted || !csorted) {
4267     Mat      new_mat;
4268     IS       is_perm_r,is_perm_c;
4269 
4270     if (!rsorted) {
4271       PetscInt *idxs_r,i;
4272       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4273       for (i=0;i<rsize;i++) {
4274         idxs_r[idxs_perm_r[i]] = i;
4275       }
4276       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4277       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4278     } else {
4279       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4280     }
4281     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4282 
4283     if (!csorted) {
4284       if (isrow_s == iscol_s) {
4285         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4286         is_perm_c = is_perm_r;
4287       } else {
4288         PetscInt *idxs_c,i;
4289         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4290         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4291         for (i=0;i<csize;i++) {
4292           idxs_c[idxs_perm_c[i]] = i;
4293         }
4294         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4295         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4296       }
4297     } else {
4298       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4299     }
4300     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4301 
4302     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4303     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4304     work_mat[0] = new_mat;
4305     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4306     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4307   }
4308 
4309   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4310   *B = work_mat[0];
4311   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4312   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4313   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4314   PetscFunctionReturn(0);
4315 }
4316 
4317 #undef __FUNCT__
4318 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
4319 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4320 {
4321   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4322   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4323   Mat            new_mat;
4324   IS             is_local,is_global;
4325   PetscInt       local_size;
4326   PetscBool      isseqaij;
4327   PetscErrorCode ierr;
4328 
4329   PetscFunctionBegin;
4330   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4331   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4332   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4333   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4334   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4335   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4336   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4337 
4338   /* check */
4339   if (pcbddc->dbg_flag) {
4340     Vec       x,x_change;
4341     PetscReal error;
4342 
4343     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4344     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4345     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4346     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4347     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4348     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4349     if (!pcbddc->change_interior) {
4350       const PetscScalar *x,*y,*v;
4351       PetscReal         lerror = 0.;
4352       PetscInt          i;
4353 
4354       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4355       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4356       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4357       for (i=0;i<local_size;i++)
4358         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4359           lerror = PetscAbsScalar(x[i]-y[i]);
4360       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4361       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4362       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4363       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4364       if (error > PETSC_SMALL) {
4365         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4366           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4367         } else {
4368           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4369         }
4370       }
4371     }
4372     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4373     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4374     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4375     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4376     if (error > PETSC_SMALL) {
4377       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4378         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4379       } else {
4380         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4381       }
4382     }
4383     ierr = VecDestroy(&x);CHKERRQ(ierr);
4384     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4385   }
4386 
4387   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4388   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4389   if (isseqaij) {
4390     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4391     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4392   } else {
4393     Mat work_mat;
4394 
4395     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4396     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4397     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4398     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4399   }
4400   if (matis->A->symmetric_set) {
4401     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4402 #if !defined(PETSC_USE_COMPLEX)
4403     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4404 #endif
4405   }
4406   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4407   PetscFunctionReturn(0);
4408 }
4409 
4410 #undef __FUNCT__
4411 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4412 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4413 {
4414   PC_IS*          pcis = (PC_IS*)(pc->data);
4415   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4416   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4417   PetscInt        *idx_R_local=NULL;
4418   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4419   PetscInt        vbs,bs;
4420   PetscBT         bitmask=NULL;
4421   PetscErrorCode  ierr;
4422 
4423   PetscFunctionBegin;
4424   /*
4425     No need to setup local scatters if
4426       - primal space is unchanged
4427         AND
4428       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4429         AND
4430       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4431   */
4432   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4433     PetscFunctionReturn(0);
4434   }
4435   /* destroy old objects */
4436   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4437   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4438   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4439   /* Set Non-overlapping dimensions */
4440   n_B = pcis->n_B;
4441   n_D = pcis->n - n_B;
4442   n_vertices = pcbddc->n_vertices;
4443 
4444   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4445 
4446   /* create auxiliary bitmask and allocate workspace */
4447   if (!sub_schurs || !sub_schurs->reuse_solver) {
4448     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4449     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4450     for (i=0;i<n_vertices;i++) {
4451       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4452     }
4453 
4454     for (i=0, n_R=0; i<pcis->n; i++) {
4455       if (!PetscBTLookup(bitmask,i)) {
4456         idx_R_local[n_R++] = i;
4457       }
4458     }
4459   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4460     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4461 
4462     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4463     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4464   }
4465 
4466   /* Block code */
4467   vbs = 1;
4468   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4469   if (bs>1 && !(n_vertices%bs)) {
4470     PetscBool is_blocked = PETSC_TRUE;
4471     PetscInt  *vary;
4472     if (!sub_schurs || !sub_schurs->reuse_solver) {
4473       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4474       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4475       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4476       /* 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 */
4477       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4478       for (i=0; i<pcis->n/bs; i++) {
4479         if (vary[i]!=0 && vary[i]!=bs) {
4480           is_blocked = PETSC_FALSE;
4481           break;
4482         }
4483       }
4484       ierr = PetscFree(vary);CHKERRQ(ierr);
4485     } else {
4486       /* Verify directly the R set */
4487       for (i=0; i<n_R/bs; i++) {
4488         PetscInt j,node=idx_R_local[bs*i];
4489         for (j=1; j<bs; j++) {
4490           if (node != idx_R_local[bs*i+j]-j) {
4491             is_blocked = PETSC_FALSE;
4492             break;
4493           }
4494         }
4495       }
4496     }
4497     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4498       vbs = bs;
4499       for (i=0;i<n_R/vbs;i++) {
4500         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4501       }
4502     }
4503   }
4504   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4505   if (sub_schurs && sub_schurs->reuse_solver) {
4506     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4507 
4508     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4509     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4510     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4511     reuse_solver->is_R = pcbddc->is_R_local;
4512   } else {
4513     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4514   }
4515 
4516   /* print some info if requested */
4517   if (pcbddc->dbg_flag) {
4518     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4519     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4520     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4521     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4522     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4523     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);
4524     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4525   }
4526 
4527   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4528   if (!sub_schurs || !sub_schurs->reuse_solver) {
4529     IS       is_aux1,is_aux2;
4530     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4531 
4532     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4533     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4534     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4535     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4536     for (i=0; i<n_D; i++) {
4537       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4538     }
4539     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4540     for (i=0, j=0; i<n_R; i++) {
4541       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4542         aux_array1[j++] = i;
4543       }
4544     }
4545     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4546     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4547     for (i=0, j=0; i<n_B; i++) {
4548       if (!PetscBTLookup(bitmask,is_indices[i])) {
4549         aux_array2[j++] = i;
4550       }
4551     }
4552     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4553     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4554     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4555     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4556     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4557 
4558     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4559       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4560       for (i=0, j=0; i<n_R; i++) {
4561         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4562           aux_array1[j++] = i;
4563         }
4564       }
4565       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4566       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4567       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4568     }
4569     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4570     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4571   } else {
4572     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4573     IS                 tis;
4574     PetscInt           schur_size;
4575 
4576     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4577     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4578     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4579     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4580     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4581       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4582       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4583       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4584     }
4585   }
4586   PetscFunctionReturn(0);
4587 }
4588 
4589 
4590 #undef __FUNCT__
4591 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4592 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4593 {
4594   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4595   PC_IS          *pcis = (PC_IS*)pc->data;
4596   PC             pc_temp;
4597   Mat            A_RR;
4598   MatReuse       reuse;
4599   PetscScalar    m_one = -1.0;
4600   PetscReal      value;
4601   PetscInt       n_D,n_R;
4602   PetscBool      check_corr[2],issbaij;
4603   PetscErrorCode ierr;
4604   /* prefixes stuff */
4605   char           dir_prefix[256],neu_prefix[256],str_level[16];
4606   size_t         len;
4607 
4608   PetscFunctionBegin;
4609 
4610   /* compute prefixes */
4611   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4612   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4613   if (!pcbddc->current_level) {
4614     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4615     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4616     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4617     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4618   } else {
4619     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4620     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4621     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4622     len -= 15; /* remove "pc_bddc_coarse_" */
4623     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4624     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4625     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4626     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4627     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4628     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4629     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4630     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4631   }
4632 
4633   /* DIRICHLET PROBLEM */
4634   if (dirichlet) {
4635     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4636     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4637       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4638       if (pcbddc->dbg_flag) {
4639         Mat    A_IIn;
4640 
4641         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4642         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4643         pcis->A_II = A_IIn;
4644       }
4645     }
4646     if (pcbddc->local_mat->symmetric_set) {
4647       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4648     }
4649     /* Matrix for Dirichlet problem is pcis->A_II */
4650     n_D = pcis->n - pcis->n_B;
4651     if (!pcbddc->ksp_D) { /* create object if not yet build */
4652       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4653       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4654       /* default */
4655       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4656       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4657       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4658       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4659       if (issbaij) {
4660         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4661       } else {
4662         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4663       }
4664       /* Allow user's customization */
4665       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4666       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4667     }
4668     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4669     if (sub_schurs && sub_schurs->reuse_solver) {
4670       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4671 
4672       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4673     }
4674     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4675     if (!n_D) {
4676       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4677       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4678     }
4679     /* Set Up KSP for Dirichlet problem of BDDC */
4680     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4681     /* set ksp_D into pcis data */
4682     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4683     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4684     pcis->ksp_D = pcbddc->ksp_D;
4685   }
4686 
4687   /* NEUMANN PROBLEM */
4688   A_RR = 0;
4689   if (neumann) {
4690     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4691     PetscInt        ibs,mbs;
4692     PetscBool       issbaij;
4693     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4694     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4695     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4696     if (pcbddc->ksp_R) { /* already created ksp */
4697       PetscInt nn_R;
4698       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4699       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4700       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4701       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4702         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4703         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4704         reuse = MAT_INITIAL_MATRIX;
4705       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4706         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4707           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4708           reuse = MAT_INITIAL_MATRIX;
4709         } else { /* safe to reuse the matrix */
4710           reuse = MAT_REUSE_MATRIX;
4711         }
4712       }
4713       /* last check */
4714       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4715         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4716         reuse = MAT_INITIAL_MATRIX;
4717       }
4718     } else { /* first time, so we need to create the matrix */
4719       reuse = MAT_INITIAL_MATRIX;
4720     }
4721     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4722     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4723     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4724     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4725     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4726       if (matis->A == pcbddc->local_mat) {
4727         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4728         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4729       } else {
4730         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4731       }
4732     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4733       if (matis->A == pcbddc->local_mat) {
4734         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4735         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4736       } else {
4737         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4738       }
4739     }
4740     /* extract A_RR */
4741     if (sub_schurs && sub_schurs->reuse_solver) {
4742       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4743 
4744       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4745         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4746         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4747           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4748         } else {
4749           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4750         }
4751       } else {
4752         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4753         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4754         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4755       }
4756     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4757       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4758     }
4759     if (pcbddc->local_mat->symmetric_set) {
4760       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4761     }
4762     if (!pcbddc->ksp_R) { /* create object if not present */
4763       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4764       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4765       /* default */
4766       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4767       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4768       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4769       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4770       if (issbaij) {
4771         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4772       } else {
4773         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4774       }
4775       /* Allow user's customization */
4776       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4777       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4778     }
4779     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4780     if (!n_R) {
4781       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4782       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4783     }
4784     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4785     /* Reuse solver if it is present */
4786     if (sub_schurs && sub_schurs->reuse_solver) {
4787       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4788 
4789       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4790     }
4791     /* Set Up KSP for Neumann problem of BDDC */
4792     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4793   }
4794 
4795   if (pcbddc->dbg_flag) {
4796     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4797     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4798     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4799   }
4800 
4801   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4802   check_corr[0] = check_corr[1] = PETSC_FALSE;
4803   if (pcbddc->NullSpace_corr[0]) {
4804     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4805   }
4806   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4807     check_corr[0] = PETSC_TRUE;
4808     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4809   }
4810   if (neumann && pcbddc->NullSpace_corr[2]) {
4811     check_corr[1] = PETSC_TRUE;
4812     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4813   }
4814 
4815   /* check Dirichlet and Neumann solvers */
4816   if (pcbddc->dbg_flag) {
4817     if (dirichlet) { /* Dirichlet */
4818       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4819       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4820       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4821       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4822       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4823       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);
4824       if (check_corr[0]) {
4825         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4826       }
4827       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4828     }
4829     if (neumann) { /* Neumann */
4830       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4831       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4832       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4833       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4834       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4835       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);
4836       if (check_corr[1]) {
4837         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4838       }
4839       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4840     }
4841   }
4842   /* free Neumann problem's matrix */
4843   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4844   PetscFunctionReturn(0);
4845 }
4846 
4847 #undef __FUNCT__
4848 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4849 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4850 {
4851   PetscErrorCode  ierr;
4852   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4853   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4854   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4855 
4856   PetscFunctionBegin;
4857   if (!reuse_solver) {
4858     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4859   }
4860   if (!pcbddc->switch_static) {
4861     if (applytranspose && pcbddc->local_auxmat1) {
4862       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4863       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4864     }
4865     if (!reuse_solver) {
4866       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4867       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4868     } else {
4869       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4870 
4871       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4872       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4873     }
4874   } else {
4875     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4876     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4877     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4878     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4879     if (applytranspose && pcbddc->local_auxmat1) {
4880       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4881       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4882       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4883       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4884     }
4885   }
4886   if (!reuse_solver || pcbddc->switch_static) {
4887     if (applytranspose) {
4888       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4889     } else {
4890       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4891     }
4892   } else {
4893     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4894 
4895     if (applytranspose) {
4896       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4897     } else {
4898       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4899     }
4900   }
4901   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4902   if (!pcbddc->switch_static) {
4903     if (!reuse_solver) {
4904       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4905       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4906     } else {
4907       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4908 
4909       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4910       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4911     }
4912     if (!applytranspose && pcbddc->local_auxmat1) {
4913       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4914       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4915     }
4916   } else {
4917     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4918     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4919     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4920     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4921     if (!applytranspose && pcbddc->local_auxmat1) {
4922       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4923       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4924     }
4925     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4926     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4927     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4928     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4929   }
4930   PetscFunctionReturn(0);
4931 }
4932 
4933 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
4934 #undef __FUNCT__
4935 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
4936 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
4937 {
4938   PetscErrorCode ierr;
4939   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4940   PC_IS*            pcis = (PC_IS*)  (pc->data);
4941   const PetscScalar zero = 0.0;
4942 
4943   PetscFunctionBegin;
4944   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
4945   if (!pcbddc->benign_apply_coarse_only) {
4946     if (applytranspose) {
4947       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4948       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4949     } else {
4950       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4951       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4952     }
4953   } else {
4954     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
4955   }
4956 
4957   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
4958   if (pcbddc->benign_n) {
4959     PetscScalar *array;
4960     PetscInt    j;
4961 
4962     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4963     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
4964     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4965   }
4966 
4967   /* start communications from local primal nodes to rhs of coarse solver */
4968   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
4969   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4970   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4971 
4972   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
4973   if (pcbddc->coarse_ksp) {
4974     Mat          coarse_mat;
4975     Vec          rhs,sol;
4976     MatNullSpace nullsp;
4977     PetscBool    isbddc = PETSC_FALSE;
4978 
4979     if (pcbddc->benign_have_null) {
4980       PC        coarse_pc;
4981 
4982       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
4983       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
4984       /* we need to propagate to coarser levels the need for a possible benign correction */
4985       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
4986         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
4987         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
4988         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
4989       }
4990     }
4991     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
4992     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
4993     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4994     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
4995     if (nullsp) {
4996       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
4997     }
4998     if (applytranspose) {
4999       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5000       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5001     } else {
5002       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5003         PC        coarse_pc;
5004 
5005         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5006         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5007         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5008         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5009       } else {
5010         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5011       }
5012     }
5013     /* we don't need the benign correction at coarser levels anymore */
5014     if (pcbddc->benign_have_null && isbddc) {
5015       PC        coarse_pc;
5016       PC_BDDC*  coarsepcbddc;
5017 
5018       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5019       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5020       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5021       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5022     }
5023     if (nullsp) {
5024       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5025     }
5026   }
5027 
5028   /* Local solution on R nodes */
5029   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5030     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5031   }
5032   /* communications from coarse sol to local primal nodes */
5033   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5034   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5035 
5036   /* Sum contributions from the two levels */
5037   if (!pcbddc->benign_apply_coarse_only) {
5038     if (applytranspose) {
5039       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5040       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5041     } else {
5042       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5043       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5044     }
5045     /* store p0 */
5046     if (pcbddc->benign_n) {
5047       PetscScalar *array;
5048       PetscInt    j;
5049 
5050       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5051       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5052       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5053     }
5054   } else { /* expand the coarse solution */
5055     if (applytranspose) {
5056       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5057     } else {
5058       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5059     }
5060   }
5061   PetscFunctionReturn(0);
5062 }
5063 
5064 #undef __FUNCT__
5065 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5066 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5067 {
5068   PetscErrorCode ierr;
5069   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5070   PetscScalar    *array;
5071   Vec            from,to;
5072 
5073   PetscFunctionBegin;
5074   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5075     from = pcbddc->coarse_vec;
5076     to = pcbddc->vec1_P;
5077     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5078       Vec tvec;
5079 
5080       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5081       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5082       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5083       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5084       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5085       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5086     }
5087   } else { /* from local to global -> put data in coarse right hand side */
5088     from = pcbddc->vec1_P;
5089     to = pcbddc->coarse_vec;
5090   }
5091   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5092   PetscFunctionReturn(0);
5093 }
5094 
5095 #undef __FUNCT__
5096 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5097 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5098 {
5099   PetscErrorCode ierr;
5100   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5101   PetscScalar    *array;
5102   Vec            from,to;
5103 
5104   PetscFunctionBegin;
5105   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5106     from = pcbddc->coarse_vec;
5107     to = pcbddc->vec1_P;
5108   } else { /* from local to global -> put data in coarse right hand side */
5109     from = pcbddc->vec1_P;
5110     to = pcbddc->coarse_vec;
5111   }
5112   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5113   if (smode == SCATTER_FORWARD) {
5114     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5115       Vec tvec;
5116 
5117       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5118       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5119       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5120       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5121     }
5122   } else {
5123     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5124      ierr = VecResetArray(from);CHKERRQ(ierr);
5125     }
5126   }
5127   PetscFunctionReturn(0);
5128 }
5129 
5130 /* uncomment for testing purposes */
5131 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5132 #undef __FUNCT__
5133 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5134 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5135 {
5136   PetscErrorCode    ierr;
5137   PC_IS*            pcis = (PC_IS*)(pc->data);
5138   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5139   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5140   /* one and zero */
5141   PetscScalar       one=1.0,zero=0.0;
5142   /* space to store constraints and their local indices */
5143   PetscScalar       *constraints_data;
5144   PetscInt          *constraints_idxs,*constraints_idxs_B;
5145   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5146   PetscInt          *constraints_n;
5147   /* iterators */
5148   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5149   /* BLAS integers */
5150   PetscBLASInt      lwork,lierr;
5151   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5152   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5153   /* reuse */
5154   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5155   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5156   /* change of basis */
5157   PetscBool         qr_needed;
5158   PetscBT           change_basis,qr_needed_idx;
5159   /* auxiliary stuff */
5160   PetscInt          *nnz,*is_indices;
5161   PetscInt          ncc;
5162   /* some quantities */
5163   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5164   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5165 
5166   PetscFunctionBegin;
5167   /* Destroy Mat objects computed previously */
5168   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5169   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5170   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5171   /* save info on constraints from previous setup (if any) */
5172   olocal_primal_size = pcbddc->local_primal_size;
5173   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5174   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5175   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5176   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5177   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5178   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5179 
5180   if (!pcbddc->adaptive_selection) {
5181     IS           ISForVertices,*ISForFaces,*ISForEdges;
5182     MatNullSpace nearnullsp;
5183     const Vec    *nearnullvecs;
5184     Vec          *localnearnullsp;
5185     PetscScalar  *array;
5186     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5187     PetscBool    nnsp_has_cnst;
5188     /* LAPACK working arrays for SVD or POD */
5189     PetscBool    skip_lapack,boolforchange;
5190     PetscScalar  *work;
5191     PetscReal    *singular_vals;
5192 #if defined(PETSC_USE_COMPLEX)
5193     PetscReal    *rwork;
5194 #endif
5195 #if defined(PETSC_MISSING_LAPACK_GESVD)
5196     PetscScalar  *temp_basis,*correlation_mat;
5197 #else
5198     PetscBLASInt dummy_int=1;
5199     PetscScalar  dummy_scalar=1.;
5200 #endif
5201 
5202     /* Get index sets for faces, edges and vertices from graph */
5203     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5204     /* print some info */
5205     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5206       PetscInt nv;
5207 
5208       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5209       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5210       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5211       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5212       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5213       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5214       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5215       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5216       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5217     }
5218 
5219     /* free unneeded index sets */
5220     if (!pcbddc->use_vertices) {
5221       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5222     }
5223     if (!pcbddc->use_edges) {
5224       for (i=0;i<n_ISForEdges;i++) {
5225         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5226       }
5227       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5228       n_ISForEdges = 0;
5229     }
5230     if (!pcbddc->use_faces) {
5231       for (i=0;i<n_ISForFaces;i++) {
5232         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5233       }
5234       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5235       n_ISForFaces = 0;
5236     }
5237 
5238     /* check if near null space is attached to global mat */
5239     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5240     if (nearnullsp) {
5241       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5242       /* remove any stored info */
5243       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5244       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5245       /* store information for BDDC solver reuse */
5246       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5247       pcbddc->onearnullspace = nearnullsp;
5248       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5249       for (i=0;i<nnsp_size;i++) {
5250         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5251       }
5252     } else { /* if near null space is not provided BDDC uses constants by default */
5253       nnsp_size = 0;
5254       nnsp_has_cnst = PETSC_TRUE;
5255     }
5256     /* get max number of constraints on a single cc */
5257     max_constraints = nnsp_size;
5258     if (nnsp_has_cnst) max_constraints++;
5259 
5260     /*
5261          Evaluate maximum storage size needed by the procedure
5262          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5263          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5264          There can be multiple constraints per connected component
5265                                                                                                                                                            */
5266     n_vertices = 0;
5267     if (ISForVertices) {
5268       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5269     }
5270     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5271     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5272 
5273     total_counts = n_ISForFaces+n_ISForEdges;
5274     total_counts *= max_constraints;
5275     total_counts += n_vertices;
5276     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5277 
5278     total_counts = 0;
5279     max_size_of_constraint = 0;
5280     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5281       IS used_is;
5282       if (i<n_ISForEdges) {
5283         used_is = ISForEdges[i];
5284       } else {
5285         used_is = ISForFaces[i-n_ISForEdges];
5286       }
5287       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5288       total_counts += j;
5289       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5290     }
5291     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);
5292 
5293     /* get local part of global near null space vectors */
5294     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5295     for (k=0;k<nnsp_size;k++) {
5296       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5297       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5298       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5299     }
5300 
5301     /* whether or not to skip lapack calls */
5302     skip_lapack = PETSC_TRUE;
5303     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5304 
5305     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5306     if (!skip_lapack) {
5307       PetscScalar temp_work;
5308 
5309 #if defined(PETSC_MISSING_LAPACK_GESVD)
5310       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5311       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5312       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5313       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5314 #if defined(PETSC_USE_COMPLEX)
5315       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5316 #endif
5317       /* now we evaluate the optimal workspace using query with lwork=-1 */
5318       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5319       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5320       lwork = -1;
5321       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5322 #if !defined(PETSC_USE_COMPLEX)
5323       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5324 #else
5325       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5326 #endif
5327       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5328       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5329 #else /* on missing GESVD */
5330       /* SVD */
5331       PetscInt max_n,min_n;
5332       max_n = max_size_of_constraint;
5333       min_n = max_constraints;
5334       if (max_size_of_constraint < max_constraints) {
5335         min_n = max_size_of_constraint;
5336         max_n = max_constraints;
5337       }
5338       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5339 #if defined(PETSC_USE_COMPLEX)
5340       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5341 #endif
5342       /* now we evaluate the optimal workspace using query with lwork=-1 */
5343       lwork = -1;
5344       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5345       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5346       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5347       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5348 #if !defined(PETSC_USE_COMPLEX)
5349       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));
5350 #else
5351       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));
5352 #endif
5353       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5354       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5355 #endif /* on missing GESVD */
5356       /* Allocate optimal workspace */
5357       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5358       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5359     }
5360     /* Now we can loop on constraining sets */
5361     total_counts = 0;
5362     constraints_idxs_ptr[0] = 0;
5363     constraints_data_ptr[0] = 0;
5364     /* vertices */
5365     if (n_vertices) {
5366       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5367       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5368       for (i=0;i<n_vertices;i++) {
5369         constraints_n[total_counts] = 1;
5370         constraints_data[total_counts] = 1.0;
5371         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5372         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5373         total_counts++;
5374       }
5375       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5376       n_vertices = total_counts;
5377     }
5378 
5379     /* edges and faces */
5380     total_counts_cc = total_counts;
5381     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5382       IS        used_is;
5383       PetscBool idxs_copied = PETSC_FALSE;
5384 
5385       if (ncc<n_ISForEdges) {
5386         used_is = ISForEdges[ncc];
5387         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5388       } else {
5389         used_is = ISForFaces[ncc-n_ISForEdges];
5390         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5391       }
5392       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5393 
5394       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5395       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5396       /* change of basis should not be performed on local periodic nodes */
5397       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5398       if (nnsp_has_cnst) {
5399         PetscScalar quad_value;
5400 
5401         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5402         idxs_copied = PETSC_TRUE;
5403 
5404         if (!pcbddc->use_nnsp_true) {
5405           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5406         } else {
5407           quad_value = 1.0;
5408         }
5409         for (j=0;j<size_of_constraint;j++) {
5410           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5411         }
5412         temp_constraints++;
5413         total_counts++;
5414       }
5415       for (k=0;k<nnsp_size;k++) {
5416         PetscReal real_value;
5417         PetscScalar *ptr_to_data;
5418 
5419         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5420         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5421         for (j=0;j<size_of_constraint;j++) {
5422           ptr_to_data[j] = array[is_indices[j]];
5423         }
5424         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5425         /* check if array is null on the connected component */
5426         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5427         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5428         if (real_value > 0.0) { /* keep indices and values */
5429           temp_constraints++;
5430           total_counts++;
5431           if (!idxs_copied) {
5432             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5433             idxs_copied = PETSC_TRUE;
5434           }
5435         }
5436       }
5437       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5438       valid_constraints = temp_constraints;
5439       if (!pcbddc->use_nnsp_true && temp_constraints) {
5440         if (temp_constraints == 1) { /* just normalize the constraint */
5441           PetscScalar norm,*ptr_to_data;
5442 
5443           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5444           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5445           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5446           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5447           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5448         } else { /* perform SVD */
5449           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5450           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5451 
5452 #if defined(PETSC_MISSING_LAPACK_GESVD)
5453           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5454              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5455              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5456                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5457                 from that computed using LAPACKgesvd
5458              -> This is due to a different computation of eigenvectors in LAPACKheev
5459              -> The quality of the POD-computed basis will be the same */
5460           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5461           /* Store upper triangular part of correlation matrix */
5462           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5463           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5464           for (j=0;j<temp_constraints;j++) {
5465             for (k=0;k<j+1;k++) {
5466               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));
5467             }
5468           }
5469           /* compute eigenvalues and eigenvectors of correlation matrix */
5470           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5471           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5472 #if !defined(PETSC_USE_COMPLEX)
5473           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5474 #else
5475           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5476 #endif
5477           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5478           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5479           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5480           j = 0;
5481           while (j < temp_constraints && singular_vals[j] < tol) j++;
5482           total_counts = total_counts-j;
5483           valid_constraints = temp_constraints-j;
5484           /* scale and copy POD basis into used quadrature memory */
5485           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5486           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5487           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5488           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5489           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5490           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5491           if (j<temp_constraints) {
5492             PetscInt ii;
5493             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5494             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5495             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));
5496             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5497             for (k=0;k<temp_constraints-j;k++) {
5498               for (ii=0;ii<size_of_constraint;ii++) {
5499                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5500               }
5501             }
5502           }
5503 #else  /* on missing GESVD */
5504           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5505           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5506           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5507           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5508 #if !defined(PETSC_USE_COMPLEX)
5509           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));
5510 #else
5511           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));
5512 #endif
5513           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5514           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5515           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5516           k = temp_constraints;
5517           if (k > size_of_constraint) k = size_of_constraint;
5518           j = 0;
5519           while (j < k && singular_vals[k-j-1] < tol) j++;
5520           valid_constraints = k-j;
5521           total_counts = total_counts-temp_constraints+valid_constraints;
5522 #endif /* on missing GESVD */
5523         }
5524       }
5525       /* update pointers information */
5526       if (valid_constraints) {
5527         constraints_n[total_counts_cc] = valid_constraints;
5528         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5529         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5530         /* set change_of_basis flag */
5531         if (boolforchange) {
5532           PetscBTSet(change_basis,total_counts_cc);
5533         }
5534         total_counts_cc++;
5535       }
5536     }
5537     /* free workspace */
5538     if (!skip_lapack) {
5539       ierr = PetscFree(work);CHKERRQ(ierr);
5540 #if defined(PETSC_USE_COMPLEX)
5541       ierr = PetscFree(rwork);CHKERRQ(ierr);
5542 #endif
5543       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5544 #if defined(PETSC_MISSING_LAPACK_GESVD)
5545       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5546       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5547 #endif
5548     }
5549     for (k=0;k<nnsp_size;k++) {
5550       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5551     }
5552     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5553     /* free index sets of faces, edges and vertices */
5554     for (i=0;i<n_ISForFaces;i++) {
5555       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5556     }
5557     if (n_ISForFaces) {
5558       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5559     }
5560     for (i=0;i<n_ISForEdges;i++) {
5561       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5562     }
5563     if (n_ISForEdges) {
5564       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5565     }
5566     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5567   } else {
5568     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5569 
5570     total_counts = 0;
5571     n_vertices = 0;
5572     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5573       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5574     }
5575     max_constraints = 0;
5576     total_counts_cc = 0;
5577     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5578       total_counts += pcbddc->adaptive_constraints_n[i];
5579       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5580       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5581     }
5582     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5583     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5584     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5585     constraints_data = pcbddc->adaptive_constraints_data;
5586     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5587     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5588     total_counts_cc = 0;
5589     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5590       if (pcbddc->adaptive_constraints_n[i]) {
5591         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5592       }
5593     }
5594 #if 0
5595     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5596     for (i=0;i<total_counts_cc;i++) {
5597       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5598       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5599       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5600         printf(" %d",constraints_idxs[j]);
5601       }
5602       printf("\n");
5603       printf("number of cc: %d\n",constraints_n[i]);
5604     }
5605     for (i=0;i<n_vertices;i++) {
5606       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5607     }
5608     for (i=0;i<sub_schurs->n_subs;i++) {
5609       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]);
5610     }
5611 #endif
5612 
5613     max_size_of_constraint = 0;
5614     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]);
5615     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5616     /* Change of basis */
5617     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5618     if (pcbddc->use_change_of_basis) {
5619       for (i=0;i<sub_schurs->n_subs;i++) {
5620         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5621           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5622         }
5623       }
5624     }
5625   }
5626   pcbddc->local_primal_size = total_counts;
5627   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5628 
5629   /* map constraints_idxs in boundary numbering */
5630   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5631   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);
5632 
5633   /* Create constraint matrix */
5634   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5635   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5636   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5637 
5638   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5639   /* determine if a QR strategy is needed for change of basis */
5640   qr_needed = PETSC_FALSE;
5641   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5642   total_primal_vertices=0;
5643   pcbddc->local_primal_size_cc = 0;
5644   for (i=0;i<total_counts_cc;i++) {
5645     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5646     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5647       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5648       pcbddc->local_primal_size_cc += 1;
5649     } else if (PetscBTLookup(change_basis,i)) {
5650       for (k=0;k<constraints_n[i];k++) {
5651         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5652       }
5653       pcbddc->local_primal_size_cc += constraints_n[i];
5654       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5655         PetscBTSet(qr_needed_idx,i);
5656         qr_needed = PETSC_TRUE;
5657       }
5658     } else {
5659       pcbddc->local_primal_size_cc += 1;
5660     }
5661   }
5662   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5663   pcbddc->n_vertices = total_primal_vertices;
5664   /* permute indices in order to have a sorted set of vertices */
5665   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5666   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);
5667   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5668   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5669 
5670   /* nonzero structure of constraint matrix */
5671   /* and get reference dof for local constraints */
5672   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5673   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5674 
5675   j = total_primal_vertices;
5676   total_counts = total_primal_vertices;
5677   cum = total_primal_vertices;
5678   for (i=n_vertices;i<total_counts_cc;i++) {
5679     if (!PetscBTLookup(change_basis,i)) {
5680       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5681       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5682       cum++;
5683       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5684       for (k=0;k<constraints_n[i];k++) {
5685         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5686         nnz[j+k] = size_of_constraint;
5687       }
5688       j += constraints_n[i];
5689     }
5690   }
5691   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5692   ierr = PetscFree(nnz);CHKERRQ(ierr);
5693 
5694   /* set values in constraint matrix */
5695   for (i=0;i<total_primal_vertices;i++) {
5696     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5697   }
5698   total_counts = total_primal_vertices;
5699   for (i=n_vertices;i<total_counts_cc;i++) {
5700     if (!PetscBTLookup(change_basis,i)) {
5701       PetscInt *cols;
5702 
5703       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5704       cols = constraints_idxs+constraints_idxs_ptr[i];
5705       for (k=0;k<constraints_n[i];k++) {
5706         PetscInt    row = total_counts+k;
5707         PetscScalar *vals;
5708 
5709         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5710         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5711       }
5712       total_counts += constraints_n[i];
5713     }
5714   }
5715   /* assembling */
5716   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5717   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5718 
5719   /*
5720   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5721   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5722   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5723   */
5724   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5725   if (pcbddc->use_change_of_basis) {
5726     /* dual and primal dofs on a single cc */
5727     PetscInt     dual_dofs,primal_dofs;
5728     /* working stuff for GEQRF */
5729     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5730     PetscBLASInt lqr_work;
5731     /* working stuff for UNGQR */
5732     PetscScalar  *gqr_work,lgqr_work_t;
5733     PetscBLASInt lgqr_work;
5734     /* working stuff for TRTRS */
5735     PetscScalar  *trs_rhs;
5736     PetscBLASInt Blas_NRHS;
5737     /* pointers for values insertion into change of basis matrix */
5738     PetscInt     *start_rows,*start_cols;
5739     PetscScalar  *start_vals;
5740     /* working stuff for values insertion */
5741     PetscBT      is_primal;
5742     PetscInt     *aux_primal_numbering_B;
5743     /* matrix sizes */
5744     PetscInt     global_size,local_size;
5745     /* temporary change of basis */
5746     Mat          localChangeOfBasisMatrix;
5747     /* extra space for debugging */
5748     PetscScalar  *dbg_work;
5749 
5750     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5751     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5752     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5753     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5754     /* nonzeros for local mat */
5755     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5756     if (!pcbddc->benign_change || pcbddc->fake_change) {
5757       for (i=0;i<pcis->n;i++) nnz[i]=1;
5758     } else {
5759       const PetscInt *ii;
5760       PetscInt       n;
5761       PetscBool      flg_row;
5762       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5763       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5764       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5765     }
5766     for (i=n_vertices;i<total_counts_cc;i++) {
5767       if (PetscBTLookup(change_basis,i)) {
5768         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5769         if (PetscBTLookup(qr_needed_idx,i)) {
5770           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5771         } else {
5772           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5773           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5774         }
5775       }
5776     }
5777     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5778     ierr = PetscFree(nnz);CHKERRQ(ierr);
5779     /* Set interior change in the matrix */
5780     if (!pcbddc->benign_change || pcbddc->fake_change) {
5781       for (i=0;i<pcis->n;i++) {
5782         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5783       }
5784     } else {
5785       const PetscInt *ii,*jj;
5786       PetscScalar    *aa;
5787       PetscInt       n;
5788       PetscBool      flg_row;
5789       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5790       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5791       for (i=0;i<n;i++) {
5792         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5793       }
5794       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5795       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5796     }
5797 
5798     if (pcbddc->dbg_flag) {
5799       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5800       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5801     }
5802 
5803 
5804     /* Now we loop on the constraints which need a change of basis */
5805     /*
5806        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5807        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5808 
5809        Basic blocks of change of basis matrix T computed by
5810 
5811           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5812 
5813             | 1        0   ...        0         s_1/S |
5814             | 0        1   ...        0         s_2/S |
5815             |              ...                        |
5816             | 0        ...            1     s_{n-1}/S |
5817             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5818 
5819             with S = \sum_{i=1}^n s_i^2
5820             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5821                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5822 
5823           - QR decomposition of constraints otherwise
5824     */
5825     if (qr_needed) {
5826       /* space to store Q */
5827       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5828       /* array to store scaling factors for reflectors */
5829       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5830       /* first we issue queries for optimal work */
5831       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5832       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5833       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5834       lqr_work = -1;
5835       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5836       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5837       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5838       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5839       lgqr_work = -1;
5840       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5841       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5842       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5843       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5844       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5845       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5846       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5847       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5848       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5849       /* array to store rhs and solution of triangular solver */
5850       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5851       /* allocating workspace for check */
5852       if (pcbddc->dbg_flag) {
5853         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5854       }
5855     }
5856     /* array to store whether a node is primal or not */
5857     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5858     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5859     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5860     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);
5861     for (i=0;i<total_primal_vertices;i++) {
5862       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5863     }
5864     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5865 
5866     /* loop on constraints and see whether or not they need a change of basis and compute it */
5867     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5868       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5869       if (PetscBTLookup(change_basis,total_counts)) {
5870         /* get constraint info */
5871         primal_dofs = constraints_n[total_counts];
5872         dual_dofs = size_of_constraint-primal_dofs;
5873 
5874         if (pcbddc->dbg_flag) {
5875           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);
5876         }
5877 
5878         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5879 
5880           /* copy quadrature constraints for change of basis check */
5881           if (pcbddc->dbg_flag) {
5882             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5883           }
5884           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5885           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5886 
5887           /* compute QR decomposition of constraints */
5888           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5889           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5890           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5891           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5892           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5893           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5894           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5895 
5896           /* explictly compute R^-T */
5897           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5898           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5899           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5900           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5901           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5902           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5903           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5904           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5905           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5906           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5907 
5908           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5909           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5910           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5911           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5912           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5913           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5914           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5915           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5916           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5917 
5918           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5919              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5920              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5921           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5922           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5923           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5924           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5925           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5926           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5927           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5928           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));
5929           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5930           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5931 
5932           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
5933           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
5934           /* insert cols for primal dofs */
5935           for (j=0;j<primal_dofs;j++) {
5936             start_vals = &qr_basis[j*size_of_constraint];
5937             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
5938             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5939           }
5940           /* insert cols for dual dofs */
5941           for (j=0,k=0;j<dual_dofs;k++) {
5942             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
5943               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
5944               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
5945               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5946               j++;
5947             }
5948           }
5949 
5950           /* check change of basis */
5951           if (pcbddc->dbg_flag) {
5952             PetscInt   ii,jj;
5953             PetscBool valid_qr=PETSC_TRUE;
5954             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
5955             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5956             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
5957             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5958             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
5959             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
5960             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5961             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));
5962             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5963             for (jj=0;jj<size_of_constraint;jj++) {
5964               for (ii=0;ii<primal_dofs;ii++) {
5965                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
5966                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
5967               }
5968             }
5969             if (!valid_qr) {
5970               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
5971               for (jj=0;jj<size_of_constraint;jj++) {
5972                 for (ii=0;ii<primal_dofs;ii++) {
5973                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
5974                     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]));
5975                   }
5976                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
5977                     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]));
5978                   }
5979                 }
5980               }
5981             } else {
5982               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
5983             }
5984           }
5985         } else { /* simple transformation block */
5986           PetscInt    row,col;
5987           PetscScalar val,norm;
5988 
5989           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5990           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
5991           for (j=0;j<size_of_constraint;j++) {
5992             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
5993             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
5994             if (!PetscBTLookup(is_primal,row_B)) {
5995               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
5996               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
5997               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
5998             } else {
5999               for (k=0;k<size_of_constraint;k++) {
6000                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6001                 if (row != col) {
6002                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6003                 } else {
6004                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6005                 }
6006                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6007               }
6008             }
6009           }
6010           if (pcbddc->dbg_flag) {
6011             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6012           }
6013         }
6014       } else {
6015         if (pcbddc->dbg_flag) {
6016           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6017         }
6018       }
6019     }
6020 
6021     /* free workspace */
6022     if (qr_needed) {
6023       if (pcbddc->dbg_flag) {
6024         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6025       }
6026       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6027       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6028       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6029       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6030       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6031     }
6032     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6033     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6034     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6035 
6036     /* assembling of global change of variable */
6037     if (!pcbddc->fake_change) {
6038       Mat      tmat;
6039       PetscInt bs;
6040 
6041       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6042       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6043       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6044       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6045       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6046       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6047       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6048       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6049       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6050       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6051       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6052       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6053       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6054       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6055       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6056       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6057       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6058       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6059 
6060       /* check */
6061       if (pcbddc->dbg_flag) {
6062         PetscReal error;
6063         Vec       x,x_change;
6064 
6065         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6066         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6067         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6068         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6069         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6070         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6071         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6072         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6073         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6074         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6075         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6076         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6077         if (error > PETSC_SMALL) {
6078           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6079         }
6080         ierr = VecDestroy(&x);CHKERRQ(ierr);
6081         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6082       }
6083       /* adapt sub_schurs computed (if any) */
6084       if (pcbddc->use_deluxe_scaling) {
6085         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6086 
6087         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);
6088         if (sub_schurs && sub_schurs->S_Ej_all) {
6089           Mat                    S_new,tmat;
6090           IS                     is_all_N,is_V_Sall = NULL;
6091 
6092           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6093           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6094           if (pcbddc->deluxe_zerorows) {
6095             ISLocalToGlobalMapping NtoSall;
6096             IS                     is_V;
6097             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6098             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6099             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6100             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6101             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6102           }
6103           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6104           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6105           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6106           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6107           if (pcbddc->deluxe_zerorows) {
6108             const PetscScalar *array;
6109             const PetscInt    *idxs_V,*idxs_all;
6110             PetscInt          i,n_V;
6111 
6112             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6113             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6114             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6115             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6116             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6117             for (i=0;i<n_V;i++) {
6118               PetscScalar val;
6119               PetscInt    idx;
6120 
6121               idx = idxs_V[i];
6122               val = array[idxs_all[idxs_V[i]]];
6123               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6124             }
6125             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6126             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6127             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6128             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6129             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6130           }
6131           sub_schurs->S_Ej_all = S_new;
6132           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6133           if (sub_schurs->sum_S_Ej_all) {
6134             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6135             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6136             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6137             if (pcbddc->deluxe_zerorows) {
6138               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6139             }
6140             sub_schurs->sum_S_Ej_all = S_new;
6141             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6142           }
6143           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6144           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6145         }
6146         /* destroy any change of basis context in sub_schurs */
6147         if (sub_schurs && sub_schurs->change) {
6148           PetscInt i;
6149 
6150           for (i=0;i<sub_schurs->n_subs;i++) {
6151             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6152           }
6153           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6154         }
6155       }
6156       if (pcbddc->switch_static) { /* need to save the local change */
6157         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6158       } else {
6159         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6160       }
6161       /* determine if any process has changed the pressures locally */
6162       pcbddc->change_interior = pcbddc->benign_have_null;
6163     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6164       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6165       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6166       pcbddc->use_qr_single = qr_needed;
6167     }
6168   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6169     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6170       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6171       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6172     } else {
6173       Mat benign_global = NULL;
6174       if (pcbddc->benign_have_null) {
6175         Mat tmat;
6176 
6177         pcbddc->change_interior = PETSC_TRUE;
6178         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6179         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6180         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6181         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6182         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6183         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6184         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6185         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6186         if (pcbddc->benign_change) {
6187           Mat M;
6188 
6189           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6190           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6191           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6192           ierr = MatDestroy(&M);CHKERRQ(ierr);
6193         } else {
6194           Mat         eye;
6195           PetscScalar *array;
6196 
6197           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6198           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6199           for (i=0;i<pcis->n;i++) {
6200             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6201           }
6202           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6203           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6204           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6205           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6206           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6207         }
6208         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6209         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6210       }
6211       if (pcbddc->user_ChangeOfBasisMatrix) {
6212         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6213         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6214       } else if (pcbddc->benign_have_null) {
6215         pcbddc->ChangeOfBasisMatrix = benign_global;
6216       }
6217     }
6218     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6219       IS             is_global;
6220       const PetscInt *gidxs;
6221 
6222       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6223       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6224       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6225       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6226       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6227     }
6228   }
6229   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6230     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6231   }
6232 
6233   if (!pcbddc->fake_change) {
6234     /* add pressure dofs to set of primal nodes for numbering purposes */
6235     for (i=0;i<pcbddc->benign_n;i++) {
6236       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6237       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6238       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6239       pcbddc->local_primal_size_cc++;
6240       pcbddc->local_primal_size++;
6241     }
6242 
6243     /* check if a new primal space has been introduced (also take into account benign trick) */
6244     pcbddc->new_primal_space_local = PETSC_TRUE;
6245     if (olocal_primal_size == pcbddc->local_primal_size) {
6246       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6247       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6248       if (!pcbddc->new_primal_space_local) {
6249         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6250         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6251       }
6252     }
6253     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6254     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6255   }
6256   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6257 
6258   /* flush dbg viewer */
6259   if (pcbddc->dbg_flag) {
6260     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6261   }
6262 
6263   /* free workspace */
6264   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6265   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6266   if (!pcbddc->adaptive_selection) {
6267     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6268     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6269   } else {
6270     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6271                       pcbddc->adaptive_constraints_idxs_ptr,
6272                       pcbddc->adaptive_constraints_data_ptr,
6273                       pcbddc->adaptive_constraints_idxs,
6274                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6275     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6276     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6277   }
6278   PetscFunctionReturn(0);
6279 }
6280 
6281 #undef __FUNCT__
6282 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6283 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6284 {
6285   ISLocalToGlobalMapping map;
6286   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6287   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6288   PetscInt               i,N;
6289   PetscBool              rcsr = PETSC_FALSE;
6290   PetscErrorCode         ierr;
6291 
6292   PetscFunctionBegin;
6293   if (pcbddc->recompute_topography) {
6294     pcbddc->graphanalyzed = PETSC_FALSE;
6295     /* Reset previously computed graph */
6296     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6297     /* Init local Graph struct */
6298     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6299     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6300     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6301 
6302     /* Check validity of the csr graph passed in by the user */
6303     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);
6304 
6305     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6306     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6307       PetscInt  *xadj,*adjncy;
6308       PetscInt  nvtxs;
6309       PetscBool flg_row=PETSC_FALSE;
6310 
6311       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6312       if (flg_row) {
6313         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6314         pcbddc->computed_rowadj = PETSC_TRUE;
6315       }
6316       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6317       rcsr = PETSC_TRUE;
6318     }
6319     if (pcbddc->dbg_flag) {
6320       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6321     }
6322 
6323     /* Setup of Graph */
6324     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6325     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6326 
6327     /* attach info on disconnected subdomains if present */
6328     if (pcbddc->n_local_subs) {
6329       PetscInt *local_subs;
6330 
6331       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6332       for (i=0;i<pcbddc->n_local_subs;i++) {
6333         const PetscInt *idxs;
6334         PetscInt       nl,j;
6335 
6336         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6337         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6338         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6339         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6340       }
6341       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6342       pcbddc->mat_graph->local_subs = local_subs;
6343     }
6344   }
6345 
6346   if (!pcbddc->graphanalyzed) {
6347     /* Graph's connected components analysis */
6348     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6349     pcbddc->graphanalyzed = PETSC_TRUE;
6350   }
6351   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6352   PetscFunctionReturn(0);
6353 }
6354 
6355 #undef __FUNCT__
6356 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6357 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6358 {
6359   PetscInt       i,j;
6360   PetscScalar    *alphas;
6361   PetscErrorCode ierr;
6362 
6363   PetscFunctionBegin;
6364   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6365   for (i=0;i<n;i++) {
6366     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6367     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6368     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6369     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6370   }
6371   ierr = PetscFree(alphas);CHKERRQ(ierr);
6372   PetscFunctionReturn(0);
6373 }
6374 
6375 #undef __FUNCT__
6376 #define __FUNCT__ "PCBDDCMatISGetSubassemblingPattern"
6377 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6378 {
6379   Mat            A;
6380   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6381   PetscMPIInt    size,rank,color;
6382   PetscInt       *xadj,*adjncy;
6383   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6384   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6385   PetscInt       void_procs,*procs_candidates = NULL;
6386   PetscInt       xadj_count,*count;
6387   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6388   PetscSubcomm   psubcomm;
6389   MPI_Comm       subcomm;
6390   PetscErrorCode ierr;
6391 
6392   PetscFunctionBegin;
6393   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6394   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6395   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6396   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6397   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6398   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6399 
6400   if (have_void) *have_void = PETSC_FALSE;
6401   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6402   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6403   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6404   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6405   im_active = !!n;
6406   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6407   void_procs = size - active_procs;
6408   /* get ranks of of non-active processes in mat communicator */
6409   if (void_procs) {
6410     PetscInt ncand;
6411 
6412     if (have_void) *have_void = PETSC_TRUE;
6413     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6414     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6415     for (i=0,ncand=0;i<size;i++) {
6416       if (!procs_candidates[i]) {
6417         procs_candidates[ncand++] = i;
6418       }
6419     }
6420     /* force n_subdomains to be not greater that the number of non-active processes */
6421     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6422   }
6423 
6424   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6425      number of subdomains requested 1 -> send to master or first candidate in voids  */
6426   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6427   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6428     PetscInt issize,isidx,dest;
6429     if (*n_subdomains == 1) dest = 0;
6430     else dest = rank;
6431     if (im_active) {
6432       issize = 1;
6433       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6434         isidx = procs_candidates[dest];
6435       } else {
6436         isidx = dest;
6437       }
6438     } else {
6439       issize = 0;
6440       isidx = -1;
6441     }
6442     if (*n_subdomains != 1) *n_subdomains = active_procs;
6443     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6444     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6445     PetscFunctionReturn(0);
6446   }
6447   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6448   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6449   threshold = PetscMax(threshold,2);
6450 
6451   /* Get info on mapping */
6452   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6453 
6454   /* build local CSR graph of subdomains' connectivity */
6455   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6456   xadj[0] = 0;
6457   xadj[1] = PetscMax(n_neighs-1,0);
6458   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6459   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6460   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6461   for (i=1;i<n_neighs;i++)
6462     for (j=0;j<n_shared[i];j++)
6463       count[shared[i][j]] += 1;
6464 
6465   xadj_count = 0;
6466   for (i=1;i<n_neighs;i++) {
6467     for (j=0;j<n_shared[i];j++) {
6468       if (count[shared[i][j]] < threshold) {
6469         adjncy[xadj_count] = neighs[i];
6470         adjncy_wgt[xadj_count] = n_shared[i];
6471         xadj_count++;
6472         break;
6473       }
6474     }
6475   }
6476   xadj[1] = xadj_count;
6477   ierr = PetscFree(count);CHKERRQ(ierr);
6478   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6479   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6480 
6481   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6482 
6483   /* Restrict work on active processes only */
6484   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6485   if (void_procs) {
6486     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6487     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6488     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6489     subcomm = PetscSubcommChild(psubcomm);
6490   } else {
6491     psubcomm = NULL;
6492     subcomm = PetscObjectComm((PetscObject)mat);
6493   }
6494 
6495   v_wgt = NULL;
6496   if (!color) {
6497     ierr = PetscFree(xadj);CHKERRQ(ierr);
6498     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6499     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6500   } else {
6501     Mat             subdomain_adj;
6502     IS              new_ranks,new_ranks_contig;
6503     MatPartitioning partitioner;
6504     PetscInt        rstart=0,rend=0;
6505     PetscInt        *is_indices,*oldranks;
6506     PetscMPIInt     size;
6507     PetscBool       aggregate;
6508 
6509     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6510     if (void_procs) {
6511       PetscInt prank = rank;
6512       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6513       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6514       for (i=0;i<xadj[1];i++) {
6515         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6516       }
6517       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6518     } else {
6519       oldranks = NULL;
6520     }
6521     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6522     if (aggregate) { /* TODO: all this part could be made more efficient */
6523       PetscInt    lrows,row,ncols,*cols;
6524       PetscMPIInt nrank;
6525       PetscScalar *vals;
6526 
6527       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6528       lrows = 0;
6529       if (nrank<redprocs) {
6530         lrows = size/redprocs;
6531         if (nrank<size%redprocs) lrows++;
6532       }
6533       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6534       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6535       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6536       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6537       row = nrank;
6538       ncols = xadj[1]-xadj[0];
6539       cols = adjncy;
6540       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6541       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6542       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6543       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6544       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6545       ierr = PetscFree(xadj);CHKERRQ(ierr);
6546       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6547       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6548       ierr = PetscFree(vals);CHKERRQ(ierr);
6549       if (use_vwgt) {
6550         Vec               v;
6551         const PetscScalar *array;
6552         PetscInt          nl;
6553 
6554         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6555         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6556         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6557         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6558         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6559         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6560         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6561         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6562         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6563         ierr = VecDestroy(&v);CHKERRQ(ierr);
6564       }
6565     } else {
6566       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6567       if (use_vwgt) {
6568         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6569         v_wgt[0] = n;
6570       }
6571     }
6572     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6573 
6574     /* Partition */
6575     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6576     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6577     if (v_wgt) {
6578       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6579     }
6580     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6581     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6582     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6583     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6584     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6585 
6586     /* renumber new_ranks to avoid "holes" in new set of processors */
6587     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6588     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6589     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6590     if (!aggregate) {
6591       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6592 #if defined(PETSC_USE_DEBUG)
6593         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6594 #endif
6595         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6596       } else if (oldranks) {
6597         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6598       } else {
6599         ranks_send_to_idx[0] = is_indices[0];
6600       }
6601     } else {
6602       PetscInt    idxs[1];
6603       PetscMPIInt tag;
6604       MPI_Request *reqs;
6605 
6606       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6607       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6608       for (i=rstart;i<rend;i++) {
6609         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6610       }
6611       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6612       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6613       ierr = PetscFree(reqs);CHKERRQ(ierr);
6614       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6615 #if defined(PETSC_USE_DEBUG)
6616         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6617 #endif
6618         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6619       } else if (oldranks) {
6620         ranks_send_to_idx[0] = oldranks[idxs[0]];
6621       } else {
6622         ranks_send_to_idx[0] = idxs[0];
6623       }
6624     }
6625     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6626     /* clean up */
6627     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6628     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6629     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6630     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6631   }
6632   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6633   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6634 
6635   /* assemble parallel IS for sends */
6636   i = 1;
6637   if (!color) i=0;
6638   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6639   PetscFunctionReturn(0);
6640 }
6641 
6642 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6643 
6644 #undef __FUNCT__
6645 #define __FUNCT__ "PCBDDCMatISSubassemble"
6646 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[])
6647 {
6648   Mat                    local_mat;
6649   IS                     is_sends_internal;
6650   PetscInt               rows,cols,new_local_rows;
6651   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6652   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6653   ISLocalToGlobalMapping l2gmap;
6654   PetscInt*              l2gmap_indices;
6655   const PetscInt*        is_indices;
6656   MatType                new_local_type;
6657   /* buffers */
6658   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6659   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6660   PetscInt               *recv_buffer_idxs_local;
6661   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6662   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6663   /* MPI */
6664   MPI_Comm               comm,comm_n;
6665   PetscSubcomm           subcomm;
6666   PetscMPIInt            n_sends,n_recvs,commsize;
6667   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6668   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6669   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6670   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6671   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6672   PetscErrorCode         ierr;
6673 
6674   PetscFunctionBegin;
6675   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6676   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6677   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6678   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6679   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6680   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6681   PetscValidLogicalCollectiveBool(mat,reuse,6);
6682   PetscValidLogicalCollectiveInt(mat,nis,8);
6683   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6684   if (nvecs) {
6685     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6686     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6687   }
6688   /* further checks */
6689   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6690   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6691   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6692   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6693   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6694   if (reuse && *mat_n) {
6695     PetscInt mrows,mcols,mnrows,mncols;
6696     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6697     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6698     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6699     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6700     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6701     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6702     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6703   }
6704   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6705   PetscValidLogicalCollectiveInt(mat,bs,0);
6706 
6707   /* prepare IS for sending if not provided */
6708   if (!is_sends) {
6709     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6710     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6711   } else {
6712     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6713     is_sends_internal = is_sends;
6714   }
6715 
6716   /* get comm */
6717   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6718 
6719   /* compute number of sends */
6720   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6721   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6722 
6723   /* compute number of receives */
6724   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6725   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6726   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6727   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6728   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6729   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6730   ierr = PetscFree(iflags);CHKERRQ(ierr);
6731 
6732   /* restrict comm if requested */
6733   subcomm = 0;
6734   destroy_mat = PETSC_FALSE;
6735   if (restrict_comm) {
6736     PetscMPIInt color,subcommsize;
6737 
6738     color = 0;
6739     if (restrict_full) {
6740       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6741     } else {
6742       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6743     }
6744     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6745     subcommsize = commsize - subcommsize;
6746     /* check if reuse has been requested */
6747     if (reuse) {
6748       if (*mat_n) {
6749         PetscMPIInt subcommsize2;
6750         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6751         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6752         comm_n = PetscObjectComm((PetscObject)*mat_n);
6753       } else {
6754         comm_n = PETSC_COMM_SELF;
6755       }
6756     } else { /* MAT_INITIAL_MATRIX */
6757       PetscMPIInt rank;
6758 
6759       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6760       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6761       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6762       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6763       comm_n = PetscSubcommChild(subcomm);
6764     }
6765     /* flag to destroy *mat_n if not significative */
6766     if (color) destroy_mat = PETSC_TRUE;
6767   } else {
6768     comm_n = comm;
6769   }
6770 
6771   /* prepare send/receive buffers */
6772   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6773   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6774   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6775   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6776   if (nis) {
6777     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6778   }
6779 
6780   /* Get data from local matrices */
6781   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6782     /* TODO: See below some guidelines on how to prepare the local buffers */
6783     /*
6784        send_buffer_vals should contain the raw values of the local matrix
6785        send_buffer_idxs should contain:
6786        - MatType_PRIVATE type
6787        - PetscInt        size_of_l2gmap
6788        - PetscInt        global_row_indices[size_of_l2gmap]
6789        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6790     */
6791   else {
6792     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6793     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6794     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6795     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6796     send_buffer_idxs[1] = i;
6797     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6798     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6799     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6800     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6801     for (i=0;i<n_sends;i++) {
6802       ilengths_vals[is_indices[i]] = len*len;
6803       ilengths_idxs[is_indices[i]] = len+2;
6804     }
6805   }
6806   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6807   /* additional is (if any) */
6808   if (nis) {
6809     PetscMPIInt psum;
6810     PetscInt j;
6811     for (j=0,psum=0;j<nis;j++) {
6812       PetscInt plen;
6813       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6814       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6815       psum += len+1; /* indices + lenght */
6816     }
6817     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6818     for (j=0,psum=0;j<nis;j++) {
6819       PetscInt plen;
6820       const PetscInt *is_array_idxs;
6821       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6822       send_buffer_idxs_is[psum] = plen;
6823       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6824       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6825       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6826       psum += plen+1; /* indices + lenght */
6827     }
6828     for (i=0;i<n_sends;i++) {
6829       ilengths_idxs_is[is_indices[i]] = psum;
6830     }
6831     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6832   }
6833 
6834   buf_size_idxs = 0;
6835   buf_size_vals = 0;
6836   buf_size_idxs_is = 0;
6837   buf_size_vecs = 0;
6838   for (i=0;i<n_recvs;i++) {
6839     buf_size_idxs += (PetscInt)olengths_idxs[i];
6840     buf_size_vals += (PetscInt)olengths_vals[i];
6841     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6842     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6843   }
6844   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6845   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6846   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6847   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6848 
6849   /* get new tags for clean communications */
6850   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6851   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6852   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6853   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6854 
6855   /* allocate for requests */
6856   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6857   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6858   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6859   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6860   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6861   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6862   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6863   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6864 
6865   /* communications */
6866   ptr_idxs = recv_buffer_idxs;
6867   ptr_vals = recv_buffer_vals;
6868   ptr_idxs_is = recv_buffer_idxs_is;
6869   ptr_vecs = recv_buffer_vecs;
6870   for (i=0;i<n_recvs;i++) {
6871     source_dest = onodes[i];
6872     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6873     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6874     ptr_idxs += olengths_idxs[i];
6875     ptr_vals += olengths_vals[i];
6876     if (nis) {
6877       source_dest = onodes_is[i];
6878       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);
6879       ptr_idxs_is += olengths_idxs_is[i];
6880     }
6881     if (nvecs) {
6882       source_dest = onodes[i];
6883       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6884       ptr_vecs += olengths_idxs[i]-2;
6885     }
6886   }
6887   for (i=0;i<n_sends;i++) {
6888     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6889     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6890     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6891     if (nis) {
6892       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);
6893     }
6894     if (nvecs) {
6895       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6896       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6897     }
6898   }
6899   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6900   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6901 
6902   /* assemble new l2g map */
6903   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6904   ptr_idxs = recv_buffer_idxs;
6905   new_local_rows = 0;
6906   for (i=0;i<n_recvs;i++) {
6907     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6908     ptr_idxs += olengths_idxs[i];
6909   }
6910   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6911   ptr_idxs = recv_buffer_idxs;
6912   new_local_rows = 0;
6913   for (i=0;i<n_recvs;i++) {
6914     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6915     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6916     ptr_idxs += olengths_idxs[i];
6917   }
6918   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6919   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6920   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6921 
6922   /* infer new local matrix type from received local matrices type */
6923   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
6924   /* 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) */
6925   if (n_recvs) {
6926     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
6927     ptr_idxs = recv_buffer_idxs;
6928     for (i=0;i<n_recvs;i++) {
6929       if ((PetscInt)new_local_type_private != *ptr_idxs) {
6930         new_local_type_private = MATAIJ_PRIVATE;
6931         break;
6932       }
6933       ptr_idxs += olengths_idxs[i];
6934     }
6935     switch (new_local_type_private) {
6936       case MATDENSE_PRIVATE:
6937         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
6938           new_local_type = MATSEQAIJ;
6939           bs = 1;
6940         } else { /* if I receive only 1 dense matrix */
6941           new_local_type = MATSEQDENSE;
6942           bs = 1;
6943         }
6944         break;
6945       case MATAIJ_PRIVATE:
6946         new_local_type = MATSEQAIJ;
6947         bs = 1;
6948         break;
6949       case MATBAIJ_PRIVATE:
6950         new_local_type = MATSEQBAIJ;
6951         break;
6952       case MATSBAIJ_PRIVATE:
6953         new_local_type = MATSEQSBAIJ;
6954         break;
6955       default:
6956         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
6957         break;
6958     }
6959   } else { /* by default, new_local_type is seqdense */
6960     new_local_type = MATSEQDENSE;
6961     bs = 1;
6962   }
6963 
6964   /* create MATIS object if needed */
6965   if (!reuse) {
6966     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
6967     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6968   } else {
6969     /* it also destroys the local matrices */
6970     if (*mat_n) {
6971       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
6972     } else { /* this is a fake object */
6973       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6974     }
6975   }
6976   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
6977   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
6978 
6979   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6980 
6981   /* Global to local map of received indices */
6982   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
6983   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
6984   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
6985 
6986   /* restore attributes -> type of incoming data and its size */
6987   buf_size_idxs = 0;
6988   for (i=0;i<n_recvs;i++) {
6989     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
6990     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
6991     buf_size_idxs += (PetscInt)olengths_idxs[i];
6992   }
6993   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
6994 
6995   /* set preallocation */
6996   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
6997   if (!newisdense) {
6998     PetscInt *new_local_nnz=0;
6999 
7000     ptr_idxs = recv_buffer_idxs_local;
7001     if (n_recvs) {
7002       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7003     }
7004     for (i=0;i<n_recvs;i++) {
7005       PetscInt j;
7006       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7007         for (j=0;j<*(ptr_idxs+1);j++) {
7008           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7009         }
7010       } else {
7011         /* TODO */
7012       }
7013       ptr_idxs += olengths_idxs[i];
7014     }
7015     if (new_local_nnz) {
7016       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7017       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7018       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7019       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7020       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7021       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7022     } else {
7023       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7024     }
7025     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7026   } else {
7027     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7028   }
7029 
7030   /* set values */
7031   ptr_vals = recv_buffer_vals;
7032   ptr_idxs = recv_buffer_idxs_local;
7033   for (i=0;i<n_recvs;i++) {
7034     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7035       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7036       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7037       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7038       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7039       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7040     } else {
7041       /* TODO */
7042     }
7043     ptr_idxs += olengths_idxs[i];
7044     ptr_vals += olengths_vals[i];
7045   }
7046   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7047   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7048   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7049   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7050   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7051 
7052 #if 0
7053   if (!restrict_comm) { /* check */
7054     Vec       lvec,rvec;
7055     PetscReal infty_error;
7056 
7057     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7058     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7059     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7060     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7061     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7062     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7063     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7064     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7065     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7066   }
7067 #endif
7068 
7069   /* assemble new additional is (if any) */
7070   if (nis) {
7071     PetscInt **temp_idxs,*count_is,j,psum;
7072 
7073     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7074     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7075     ptr_idxs = recv_buffer_idxs_is;
7076     psum = 0;
7077     for (i=0;i<n_recvs;i++) {
7078       for (j=0;j<nis;j++) {
7079         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7080         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7081         psum += plen;
7082         ptr_idxs += plen+1; /* shift pointer to received data */
7083       }
7084     }
7085     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7086     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7087     for (i=1;i<nis;i++) {
7088       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7089     }
7090     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7091     ptr_idxs = recv_buffer_idxs_is;
7092     for (i=0;i<n_recvs;i++) {
7093       for (j=0;j<nis;j++) {
7094         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7095         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7096         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7097         ptr_idxs += plen+1; /* shift pointer to received data */
7098       }
7099     }
7100     for (i=0;i<nis;i++) {
7101       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7102       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7103       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7104     }
7105     ierr = PetscFree(count_is);CHKERRQ(ierr);
7106     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7107     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7108   }
7109   /* free workspace */
7110   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7111   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7112   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7113   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7114   if (isdense) {
7115     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7116     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7117   } else {
7118     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7119   }
7120   if (nis) {
7121     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7122     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7123   }
7124 
7125   if (nvecs) {
7126     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7127     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7128     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7129     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7130     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7131     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7132     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7133     /* set values */
7134     ptr_vals = recv_buffer_vecs;
7135     ptr_idxs = recv_buffer_idxs_local;
7136     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7137     for (i=0;i<n_recvs;i++) {
7138       PetscInt j;
7139       for (j=0;j<*(ptr_idxs+1);j++) {
7140         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7141       }
7142       ptr_idxs += olengths_idxs[i];
7143       ptr_vals += olengths_idxs[i]-2;
7144     }
7145     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7146     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7147     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7148   }
7149 
7150   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7151   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7152   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7153   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7154   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7155   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7156   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7157   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7158   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7159   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7160   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7161   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7162   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7163   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7164   ierr = PetscFree(onodes);CHKERRQ(ierr);
7165   if (nis) {
7166     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7167     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7168     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7169   }
7170   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7171   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7172     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7173     for (i=0;i<nis;i++) {
7174       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7175     }
7176     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7177       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7178     }
7179     *mat_n = NULL;
7180   }
7181   PetscFunctionReturn(0);
7182 }
7183 
7184 /* temporary hack into ksp private data structure */
7185 #include <petsc/private/kspimpl.h>
7186 
7187 #undef __FUNCT__
7188 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7189 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7190 {
7191   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7192   PC_IS                  *pcis = (PC_IS*)pc->data;
7193   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7194   Mat                    coarsedivudotp = NULL;
7195   Mat                    coarseG,t_coarse_mat_is;
7196   MatNullSpace           CoarseNullSpace = NULL;
7197   ISLocalToGlobalMapping coarse_islg;
7198   IS                     coarse_is,*isarray;
7199   PetscInt               i,im_active=-1,active_procs=-1;
7200   PetscInt               nis,nisdofs,nisneu,nisvert;
7201   PC                     pc_temp;
7202   PCType                 coarse_pc_type;
7203   KSPType                coarse_ksp_type;
7204   PetscBool              multilevel_requested,multilevel_allowed;
7205   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7206   PetscInt               ncoarse,nedcfield;
7207   PetscBool              compute_vecs = PETSC_FALSE;
7208   PetscScalar            *array;
7209   MatReuse               coarse_mat_reuse;
7210   PetscBool              restr, full_restr, have_void;
7211   PetscErrorCode         ierr;
7212 
7213   PetscFunctionBegin;
7214   /* Assign global numbering to coarse dofs */
7215   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 */
7216     PetscInt ocoarse_size;
7217     compute_vecs = PETSC_TRUE;
7218     ocoarse_size = pcbddc->coarse_size;
7219     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7220     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7221     /* see if we can avoid some work */
7222     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7223       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7224       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7225         PC        pc;
7226         PetscBool isbddc;
7227 
7228         /* temporary workaround since PCBDDC does not have a reset method so far */
7229         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7230         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7231         if (isbddc) {
7232           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7233         } else {
7234           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7235         }
7236         coarse_reuse = PETSC_FALSE;
7237       } else { /* we can safely reuse already computed coarse matrix */
7238         coarse_reuse = PETSC_TRUE;
7239       }
7240     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7241       coarse_reuse = PETSC_FALSE;
7242     }
7243     /* reset any subassembling information */
7244     if (!coarse_reuse || pcbddc->recompute_topography) {
7245       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7246     }
7247   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7248     coarse_reuse = PETSC_TRUE;
7249   }
7250   /* assemble coarse matrix */
7251   if (coarse_reuse && pcbddc->coarse_ksp) {
7252     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7253     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7254     coarse_mat_reuse = MAT_REUSE_MATRIX;
7255   } else {
7256     coarse_mat = NULL;
7257     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7258   }
7259 
7260   /* creates temporary l2gmap and IS for coarse indexes */
7261   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7262   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7263 
7264   /* creates temporary MATIS object for coarse matrix */
7265   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7266   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7267   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7268   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7269   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);
7270   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7271   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7272   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7273   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7274 
7275   /* count "active" (i.e. with positive local size) and "void" processes */
7276   im_active = !!(pcis->n);
7277   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7278 
7279   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7280   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7281   /* full_restr : just use the receivers from the subassembling pattern */
7282   coarse_mat_is = NULL;
7283   multilevel_allowed = PETSC_FALSE;
7284   multilevel_requested = PETSC_FALSE;
7285   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7286   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7287   if (multilevel_requested) {
7288     ncoarse = active_procs/pcbddc->coarsening_ratio;
7289     restr = PETSC_FALSE;
7290     full_restr = PETSC_FALSE;
7291   } else {
7292     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7293     restr = PETSC_TRUE;
7294     full_restr = PETSC_TRUE;
7295   }
7296   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7297   ncoarse = PetscMax(1,ncoarse);
7298   if (!pcbddc->coarse_subassembling) {
7299     if (pcbddc->coarsening_ratio > 1) {
7300       if (multilevel_requested) {
7301         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7302       } else {
7303         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7304       }
7305     } else {
7306       PetscMPIInt size,rank;
7307       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7308       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7309       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7310       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7311     }
7312   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7313     PetscInt    psum;
7314     PetscMPIInt size;
7315     if (pcbddc->coarse_ksp) psum = 1;
7316     else psum = 0;
7317     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7318     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7319     if (ncoarse < size) have_void = PETSC_TRUE;
7320   }
7321   /* determine if we can go multilevel */
7322   if (multilevel_requested) {
7323     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7324     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7325   }
7326   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7327 
7328   /* dump subassembling pattern */
7329   if (pcbddc->dbg_flag && multilevel_allowed) {
7330     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7331   }
7332 
7333   /* compute dofs splitting and neumann boundaries for coarse dofs */
7334   nedcfield = -1;
7335   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7336     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7337     const PetscInt         *idxs;
7338     ISLocalToGlobalMapping tmap;
7339 
7340     /* create map between primal indices (in local representative ordering) and local primal numbering */
7341     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7342     /* allocate space for temporary storage */
7343     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7344     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7345     /* allocate for IS array */
7346     nisdofs = pcbddc->n_ISForDofsLocal;
7347     if (pcbddc->nedclocal) {
7348       if (pcbddc->nedfield > -1) {
7349         nedcfield = pcbddc->nedfield;
7350       } else {
7351         nedcfield = 0;
7352         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7353         nisdofs = 1;
7354       }
7355     }
7356     nisneu = !!pcbddc->NeumannBoundariesLocal;
7357     nisvert = 0; /* nisvert is not used */
7358     nis = nisdofs + nisneu + nisvert;
7359     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7360     /* dofs splitting */
7361     for (i=0;i<nisdofs;i++) {
7362       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7363       if (nedcfield != i) {
7364         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7365         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7366         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7367         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7368       } else {
7369         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7370         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7371         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7372         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7373         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7374       }
7375       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7376       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7377       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7378     }
7379     /* neumann boundaries */
7380     if (pcbddc->NeumannBoundariesLocal) {
7381       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7382       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7383       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7384       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7385       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7386       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7387       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7388       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7389     }
7390     /* free memory */
7391     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7392     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7393     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7394   } else {
7395     nis = 0;
7396     nisdofs = 0;
7397     nisneu = 0;
7398     nisvert = 0;
7399     isarray = NULL;
7400   }
7401   /* destroy no longer needed map */
7402   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7403 
7404   /* subassemble */
7405   if (multilevel_allowed) {
7406     Vec       vp[1];
7407     PetscInt  nvecs = 0;
7408     PetscBool reuse,reuser;
7409 
7410     if (coarse_mat) reuse = PETSC_TRUE;
7411     else reuse = PETSC_FALSE;
7412     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7413     vp[0] = NULL;
7414     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7415       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7416       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7417       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7418       nvecs = 1;
7419 
7420       if (pcbddc->divudotp) {
7421         Mat      B,loc_divudotp;
7422         Vec      v,p;
7423         IS       dummy;
7424         PetscInt np;
7425 
7426         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7427         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7428         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7429         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7430         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7431         ierr = VecSet(p,1.);CHKERRQ(ierr);
7432         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7433         ierr = VecDestroy(&p);CHKERRQ(ierr);
7434         ierr = MatDestroy(&B);CHKERRQ(ierr);
7435         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7436         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7437         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7438         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7439         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7440         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7441         ierr = VecDestroy(&v);CHKERRQ(ierr);
7442       }
7443     }
7444     if (reuser) {
7445       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7446     } else {
7447       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7448     }
7449     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7450       PetscScalar *arraym,*arrayv;
7451       PetscInt    nl;
7452       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7453       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7454       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7455       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7456       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7457       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7458       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7459       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7460     } else {
7461       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7462     }
7463   } else {
7464     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7465   }
7466   if (coarse_mat_is || coarse_mat) {
7467     PetscMPIInt size;
7468     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7469     if (!multilevel_allowed) {
7470       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7471     } else {
7472       Mat A;
7473 
7474       /* if this matrix is present, it means we are not reusing the coarse matrix */
7475       if (coarse_mat_is) {
7476         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7477         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7478         coarse_mat = coarse_mat_is;
7479       }
7480       /* be sure we don't have MatSeqDENSE as local mat */
7481       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7482       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7483     }
7484   }
7485   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7486   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7487 
7488   /* create local to global scatters for coarse problem */
7489   if (compute_vecs) {
7490     PetscInt lrows;
7491     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7492     if (coarse_mat) {
7493       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7494     } else {
7495       lrows = 0;
7496     }
7497     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7498     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7499     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7500     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7501     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7502   }
7503   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7504 
7505   /* set defaults for coarse KSP and PC */
7506   if (multilevel_allowed) {
7507     coarse_ksp_type = KSPRICHARDSON;
7508     coarse_pc_type = PCBDDC;
7509   } else {
7510     coarse_ksp_type = KSPPREONLY;
7511     coarse_pc_type = PCREDUNDANT;
7512   }
7513 
7514   /* print some info if requested */
7515   if (pcbddc->dbg_flag) {
7516     if (!multilevel_allowed) {
7517       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7518       if (multilevel_requested) {
7519         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);
7520       } else if (pcbddc->max_levels) {
7521         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7522       }
7523       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7524     }
7525   }
7526 
7527   /* communicate coarse discrete gradient */
7528   coarseG = NULL;
7529   if (pcbddc->nedcG && multilevel_allowed) {
7530     MPI_Comm ccomm;
7531     if (coarse_mat) {
7532       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7533     } else {
7534       ccomm = MPI_COMM_NULL;
7535     }
7536     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7537   }
7538 
7539   /* create the coarse KSP object only once with defaults */
7540   if (coarse_mat) {
7541     PetscViewer dbg_viewer = NULL;
7542     if (pcbddc->dbg_flag) {
7543       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7544       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7545     }
7546     if (!pcbddc->coarse_ksp) {
7547       char prefix[256],str_level[16];
7548       size_t len;
7549 
7550       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7551       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7552       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7553       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7554       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7555       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7556       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7557       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7558       /* TODO is this logic correct? should check for coarse_mat type */
7559       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7560       /* prefix */
7561       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7562       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7563       if (!pcbddc->current_level) {
7564         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7565         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7566       } else {
7567         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7568         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7569         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7570         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7571         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7572         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7573       }
7574       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7575       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7576       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7577       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7578       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7579       /* allow user customization */
7580       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7581     }
7582     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7583     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7584     if (nisdofs) {
7585       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7586       for (i=0;i<nisdofs;i++) {
7587         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7588       }
7589     }
7590     if (nisneu) {
7591       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7592       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7593     }
7594     if (nisvert) {
7595       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7596       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7597     }
7598     if (coarseG) {
7599       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7600     }
7601 
7602     /* get some info after set from options */
7603     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7604     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7605     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7606     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7607       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7608       isbddc = PETSC_FALSE;
7609     }
7610     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7611     if (isredundant) {
7612       KSP inner_ksp;
7613       PC  inner_pc;
7614       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7615       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7616       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7617     }
7618 
7619     /* parameters which miss an API */
7620     if (isbddc) {
7621       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7622       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7623       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7624       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7625       if (pcbddc_coarse->benign_saddle_point) {
7626         Mat                    coarsedivudotp_is;
7627         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7628         IS                     row,col;
7629         const PetscInt         *gidxs;
7630         PetscInt               n,st,M,N;
7631 
7632         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7633         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7634         st = st-n;
7635         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7636         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7637         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7638         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7639         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7640         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7641         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7642         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7643         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7644         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7645         ierr = ISDestroy(&row);CHKERRQ(ierr);
7646         ierr = ISDestroy(&col);CHKERRQ(ierr);
7647         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7648         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7649         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7650         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7651         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7652         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7653         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7654         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7655         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7656         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7657         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7658         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7659       }
7660     }
7661 
7662     /* propagate symmetry info of coarse matrix */
7663     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7664     if (pc->pmat->symmetric_set) {
7665       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7666     }
7667     if (pc->pmat->hermitian_set) {
7668       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7669     }
7670     if (pc->pmat->spd_set) {
7671       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7672     }
7673     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7674       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7675     }
7676     /* set operators */
7677     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7678     if (pcbddc->dbg_flag) {
7679       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7680     }
7681   }
7682   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7683   ierr = PetscFree(isarray);CHKERRQ(ierr);
7684 #if 0
7685   {
7686     PetscViewer viewer;
7687     char filename[256];
7688     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7689     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7690     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7691     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7692     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7693     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7694   }
7695 #endif
7696 
7697   if (pcbddc->coarse_ksp) {
7698     Vec crhs,csol;
7699 
7700     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7701     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7702     if (!csol) {
7703       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7704     }
7705     if (!crhs) {
7706       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7707     }
7708   }
7709   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7710 
7711   /* compute null space for coarse solver if the benign trick has been requested */
7712   if (pcbddc->benign_null) {
7713 
7714     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7715     for (i=0;i<pcbddc->benign_n;i++) {
7716       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7717     }
7718     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7719     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7720     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7721     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7722     if (coarse_mat) {
7723       Vec         nullv;
7724       PetscScalar *array,*array2;
7725       PetscInt    nl;
7726 
7727       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7728       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7729       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7730       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7731       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7732       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7733       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7734       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7735       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7736       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7737     }
7738   }
7739 
7740   if (pcbddc->coarse_ksp) {
7741     PetscBool ispreonly;
7742 
7743     if (CoarseNullSpace) {
7744       PetscBool isnull;
7745       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7746       if (isnull) {
7747         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7748       }
7749       /* TODO: add local nullspaces (if any) */
7750     }
7751     /* setup coarse ksp */
7752     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7753     /* Check coarse problem if in debug mode or if solving with an iterative method */
7754     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7755     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7756       KSP       check_ksp;
7757       KSPType   check_ksp_type;
7758       PC        check_pc;
7759       Vec       check_vec,coarse_vec;
7760       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7761       PetscInt  its;
7762       PetscBool compute_eigs;
7763       PetscReal *eigs_r,*eigs_c;
7764       PetscInt  neigs;
7765       const char *prefix;
7766 
7767       /* Create ksp object suitable for estimation of extreme eigenvalues */
7768       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7769       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7770       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7771       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7772       /* prevent from setup unneeded object */
7773       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7774       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7775       if (ispreonly) {
7776         check_ksp_type = KSPPREONLY;
7777         compute_eigs = PETSC_FALSE;
7778       } else {
7779         check_ksp_type = KSPGMRES;
7780         compute_eigs = PETSC_TRUE;
7781       }
7782       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7783       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7784       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7785       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7786       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7787       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7788       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7789       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7790       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7791       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7792       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7793       /* create random vec */
7794       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7795       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7796       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7797       /* solve coarse problem */
7798       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7799       /* set eigenvalue estimation if preonly has not been requested */
7800       if (compute_eigs) {
7801         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7802         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7803         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7804         if (neigs) {
7805           lambda_max = eigs_r[neigs-1];
7806           lambda_min = eigs_r[0];
7807           if (pcbddc->use_coarse_estimates) {
7808             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7809               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7810               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7811             }
7812           }
7813         }
7814       }
7815 
7816       /* check coarse problem residual error */
7817       if (pcbddc->dbg_flag) {
7818         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7819         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7820         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7821         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7822         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7823         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7824         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7825         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7826         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7827         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7828         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7829         if (CoarseNullSpace) {
7830           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7831         }
7832         if (compute_eigs) {
7833           PetscReal          lambda_max_s,lambda_min_s;
7834           KSPConvergedReason reason;
7835           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7836           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7837           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7838           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7839           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);
7840           for (i=0;i<neigs;i++) {
7841             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7842           }
7843         }
7844         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7845         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7846       }
7847       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7848       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7849       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7850       if (compute_eigs) {
7851         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7852         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7853       }
7854     }
7855   }
7856   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7857   /* print additional info */
7858   if (pcbddc->dbg_flag) {
7859     /* waits until all processes reaches this point */
7860     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7861     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7862     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7863   }
7864 
7865   /* free memory */
7866   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7867   PetscFunctionReturn(0);
7868 }
7869 
7870 #undef __FUNCT__
7871 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7872 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7873 {
7874   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7875   PC_IS*         pcis = (PC_IS*)pc->data;
7876   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7877   IS             subset,subset_mult,subset_n;
7878   PetscInt       local_size,coarse_size=0;
7879   PetscInt       *local_primal_indices=NULL;
7880   const PetscInt *t_local_primal_indices;
7881   PetscErrorCode ierr;
7882 
7883   PetscFunctionBegin;
7884   /* Compute global number of coarse dofs */
7885   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7886   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7887   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7888   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7889   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7890   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7891   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7892   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7893   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7894   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);
7895   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7896   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7897   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7898   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7899   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7900 
7901   /* check numbering */
7902   if (pcbddc->dbg_flag) {
7903     PetscScalar coarsesum,*array,*array2;
7904     PetscInt    i;
7905     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7906 
7907     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7908     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7909     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7910     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7911     /* counter */
7912     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7913     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7914     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7915     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7916     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7917     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7918     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7919     for (i=0;i<pcbddc->local_primal_size;i++) {
7920       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7921     }
7922     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7923     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
7924     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7925     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7926     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7927     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7928     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7929     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7930     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7931     for (i=0;i<pcis->n;i++) {
7932       if (array[i] != 0.0 && array[i] != array2[i]) {
7933         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
7934         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
7935         set_error = PETSC_TRUE;
7936         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
7937         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);
7938       }
7939     }
7940     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7941     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7942     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7943     for (i=0;i<pcis->n;i++) {
7944       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
7945     }
7946     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7947     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7948     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7949     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7950     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
7951     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
7952     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
7953       PetscInt *gidxs;
7954 
7955       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
7956       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
7957       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
7958       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7959       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
7960       for (i=0;i<pcbddc->local_primal_size;i++) {
7961         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);
7962       }
7963       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7964       ierr = PetscFree(gidxs);CHKERRQ(ierr);
7965     }
7966     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7967     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7968     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
7969   }
7970   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
7971   /* get back data */
7972   *coarse_size_n = coarse_size;
7973   *local_primal_indices_n = local_primal_indices;
7974   PetscFunctionReturn(0);
7975 }
7976 
7977 #undef __FUNCT__
7978 #define __FUNCT__ "PCBDDCGlobalToLocal"
7979 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
7980 {
7981   IS             localis_t;
7982   PetscInt       i,lsize,*idxs,n;
7983   PetscScalar    *vals;
7984   PetscErrorCode ierr;
7985 
7986   PetscFunctionBegin;
7987   /* get indices in local ordering exploiting local to global map */
7988   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
7989   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
7990   for (i=0;i<lsize;i++) vals[i] = 1.0;
7991   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
7992   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
7993   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
7994   if (idxs) { /* multilevel guard */
7995     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
7996   }
7997   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
7998   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
7999   ierr = PetscFree(vals);CHKERRQ(ierr);
8000   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8001   /* now compute set in local ordering */
8002   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8003   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8004   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8005   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8006   for (i=0,lsize=0;i<n;i++) {
8007     if (PetscRealPart(vals[i]) > 0.5) {
8008       lsize++;
8009     }
8010   }
8011   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8012   for (i=0,lsize=0;i<n;i++) {
8013     if (PetscRealPart(vals[i]) > 0.5) {
8014       idxs[lsize++] = i;
8015     }
8016   }
8017   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8018   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8019   *localis = localis_t;
8020   PetscFunctionReturn(0);
8021 }
8022 
8023 #undef __FUNCT__
8024 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8025 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8026 {
8027   PC_IS               *pcis=(PC_IS*)pc->data;
8028   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8029   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8030   Mat                 S_j;
8031   PetscInt            *used_xadj,*used_adjncy;
8032   PetscBool           free_used_adj;
8033   PetscErrorCode      ierr;
8034 
8035   PetscFunctionBegin;
8036   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8037   free_used_adj = PETSC_FALSE;
8038   if (pcbddc->sub_schurs_layers == -1) {
8039     used_xadj = NULL;
8040     used_adjncy = NULL;
8041   } else {
8042     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8043       used_xadj = pcbddc->mat_graph->xadj;
8044       used_adjncy = pcbddc->mat_graph->adjncy;
8045     } else if (pcbddc->computed_rowadj) {
8046       used_xadj = pcbddc->mat_graph->xadj;
8047       used_adjncy = pcbddc->mat_graph->adjncy;
8048     } else {
8049       PetscBool      flg_row=PETSC_FALSE;
8050       const PetscInt *xadj,*adjncy;
8051       PetscInt       nvtxs;
8052 
8053       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8054       if (flg_row) {
8055         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8056         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8057         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8058         free_used_adj = PETSC_TRUE;
8059       } else {
8060         pcbddc->sub_schurs_layers = -1;
8061         used_xadj = NULL;
8062         used_adjncy = NULL;
8063       }
8064       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8065     }
8066   }
8067 
8068   /* setup sub_schurs data */
8069   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8070   if (!sub_schurs->schur_explicit) {
8071     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8072     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8073     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);
8074   } else {
8075     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8076     PetscBool isseqaij,need_change = PETSC_FALSE;
8077     PetscInt  benign_n;
8078     Mat       change = NULL;
8079     Vec       scaling = NULL;
8080     IS        change_primal = NULL;
8081 
8082     if (!pcbddc->use_vertices && reuse_solvers) {
8083       PetscInt n_vertices;
8084 
8085       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8086       reuse_solvers = (PetscBool)!n_vertices;
8087     }
8088     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8089     if (!isseqaij) {
8090       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8091       if (matis->A == pcbddc->local_mat) {
8092         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8093         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8094       } else {
8095         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8096       }
8097     }
8098     if (!pcbddc->benign_change_explicit) {
8099       benign_n = pcbddc->benign_n;
8100     } else {
8101       benign_n = 0;
8102     }
8103     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8104        We need a global reduction to avoid possible deadlocks.
8105        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8106     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8107       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8108       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8109       need_change = (PetscBool)(!need_change);
8110     }
8111     /* If the user defines additional constraints, we import them here.
8112        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 */
8113     if (need_change) {
8114       PC_IS   *pcisf;
8115       PC_BDDC *pcbddcf;
8116       PC      pcf;
8117 
8118       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8119       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8120       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8121       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8122       /* hacks */
8123       pcisf = (PC_IS*)pcf->data;
8124       pcisf->is_B_local = pcis->is_B_local;
8125       pcisf->vec1_N = pcis->vec1_N;
8126       pcisf->BtoNmap = pcis->BtoNmap;
8127       pcisf->n = pcis->n;
8128       pcisf->n_B = pcis->n_B;
8129       pcbddcf = (PC_BDDC*)pcf->data;
8130       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8131       pcbddcf->mat_graph = pcbddc->mat_graph;
8132       pcbddcf->use_faces = PETSC_TRUE;
8133       pcbddcf->use_change_of_basis = PETSC_TRUE;
8134       pcbddcf->use_change_on_faces = PETSC_TRUE;
8135       pcbddcf->use_qr_single = PETSC_TRUE;
8136       pcbddcf->fake_change = PETSC_TRUE;
8137       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8138       /* store information on primal vertices and change of basis (in local numbering) */
8139       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8140       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8141       change = pcbddcf->ConstraintMatrix;
8142       pcbddcf->ConstraintMatrix = NULL;
8143       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8144       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8145       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8146       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8147       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8148       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8149       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8150       pcf->ops->destroy = NULL;
8151       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8152     }
8153     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8154     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);
8155     ierr = MatDestroy(&change);CHKERRQ(ierr);
8156     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8157   }
8158   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8159 
8160   /* free adjacency */
8161   if (free_used_adj) {
8162     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8163   }
8164   PetscFunctionReturn(0);
8165 }
8166 
8167 #undef __FUNCT__
8168 #define __FUNCT__ "PCBDDCInitSubSchurs"
8169 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8170 {
8171   PC_IS               *pcis=(PC_IS*)pc->data;
8172   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8173   PCBDDCGraph         graph;
8174   PetscErrorCode      ierr;
8175 
8176   PetscFunctionBegin;
8177   /* attach interface graph for determining subsets */
8178   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8179     IS       verticesIS,verticescomm;
8180     PetscInt vsize,*idxs;
8181 
8182     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8183     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8184     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8185     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8186     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8187     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8188     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8189     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8190     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8191     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8192     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8193   } else {
8194     graph = pcbddc->mat_graph;
8195   }
8196   /* print some info */
8197   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8198     IS       vertices;
8199     PetscInt nv,nedges,nfaces;
8200     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8201     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8202     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8203     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8204     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8205     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8206     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8207     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8208     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8209     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8210     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8211   }
8212 
8213   /* sub_schurs init */
8214   if (!pcbddc->sub_schurs) {
8215     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8216   }
8217   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8218 
8219   /* free graph struct */
8220   if (pcbddc->sub_schurs_rebuild) {
8221     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8222   }
8223   PetscFunctionReturn(0);
8224 }
8225 
8226 #undef __FUNCT__
8227 #define __FUNCT__ "PCBDDCCheckOperator"
8228 PetscErrorCode PCBDDCCheckOperator(PC pc)
8229 {
8230   PC_IS               *pcis=(PC_IS*)pc->data;
8231   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8232   PetscErrorCode      ierr;
8233 
8234   PetscFunctionBegin;
8235   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8236     IS             zerodiag = NULL;
8237     Mat            S_j,B0_B=NULL;
8238     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8239     PetscScalar    *p0_check,*array,*array2;
8240     PetscReal      norm;
8241     PetscInt       i;
8242 
8243     /* B0 and B0_B */
8244     if (zerodiag) {
8245       IS       dummy;
8246 
8247       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8248       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8249       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8250       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8251     }
8252     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8253     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8254     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8255     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8256     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8257     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8258     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8259     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8260     /* S_j */
8261     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8262     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8263 
8264     /* mimic vector in \widetilde{W}_\Gamma */
8265     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8266     /* continuous in primal space */
8267     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8268     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8269     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8270     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8271     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8272     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8273     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8274     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8275     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8276     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8277     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8278     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8279     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8280     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8281 
8282     /* assemble rhs for coarse problem */
8283     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8284     /* local with Schur */
8285     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8286     if (zerodiag) {
8287       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8288       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8289       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8290       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8291     }
8292     /* sum on primal nodes the local contributions */
8293     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8294     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8295     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8296     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8297     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8298     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8299     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8300     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8301     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8302     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8303     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8304     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8305     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8306     /* scale primal nodes (BDDC sums contibutions) */
8307     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8308     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8309     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8310     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8311     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8312     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8313     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8314     /* global: \widetilde{B0}_B w_\Gamma */
8315     if (zerodiag) {
8316       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8317       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8318       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8319       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8320     }
8321     /* BDDC */
8322     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8323     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8324 
8325     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8326     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8327     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8328     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8329     for (i=0;i<pcbddc->benign_n;i++) {
8330       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8331     }
8332     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8333     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8334     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8335     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8336     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8337     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8338   }
8339   PetscFunctionReturn(0);
8340 }
8341 
8342 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8343 #undef __FUNCT__
8344 #define __FUNCT__ "MatMPIAIJRestrict"
8345 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8346 {
8347   Mat            At;
8348   IS             rows;
8349   PetscInt       rst,ren;
8350   PetscErrorCode ierr;
8351   PetscLayout    rmap;
8352 
8353   PetscFunctionBegin;
8354   rst = ren = 0;
8355   if (ccomm != MPI_COMM_NULL) {
8356     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8357     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8358     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8359     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8360     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8361   }
8362   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8363   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8364   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8365 
8366   if (ccomm != MPI_COMM_NULL) {
8367     Mat_MPIAIJ *a,*b;
8368     IS         from,to;
8369     Vec        gvec;
8370     PetscInt   lsize;
8371 
8372     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8373     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8374     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8375     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8376     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8377     a    = (Mat_MPIAIJ*)At->data;
8378     b    = (Mat_MPIAIJ*)(*B)->data;
8379     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8380     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8381     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8382     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8383     b->A = a->A;
8384     b->B = a->B;
8385 
8386     b->donotstash      = a->donotstash;
8387     b->roworiented     = a->roworiented;
8388     b->rowindices      = 0;
8389     b->rowvalues       = 0;
8390     b->getrowactive    = PETSC_FALSE;
8391 
8392     (*B)->rmap         = rmap;
8393     (*B)->factortype   = A->factortype;
8394     (*B)->assembled    = PETSC_TRUE;
8395     (*B)->insertmode   = NOT_SET_VALUES;
8396     (*B)->preallocated = PETSC_TRUE;
8397 
8398     if (a->colmap) {
8399 #if defined(PETSC_USE_CTABLE)
8400       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8401 #else
8402       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8403       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8404       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8405 #endif
8406     } else b->colmap = 0;
8407     if (a->garray) {
8408       PetscInt len;
8409       len  = a->B->cmap->n;
8410       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8411       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8412       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8413     } else b->garray = 0;
8414 
8415     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8416     b->lvec = a->lvec;
8417     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8418 
8419     /* cannot use VecScatterCopy */
8420     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8421     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8422     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8423     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8424     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8425     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8426     ierr = ISDestroy(&from);CHKERRQ(ierr);
8427     ierr = ISDestroy(&to);CHKERRQ(ierr);
8428     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8429   }
8430   ierr = MatDestroy(&At);CHKERRQ(ierr);
8431   PetscFunctionReturn(0);
8432 }
8433