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