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