xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 6d9e27e4bcdd1f0cd634244a1518dcbe2650fbba)
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 <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat               GEc;
121     const PetscScalar *vals;
122     PetscScalar       v;
123 
124     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
125     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
126     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
127     /* v    = PetscAbsScalar(vals[0]) */;
128     v    = 1.;
129     cvals[0] = vals[0]/v;
130     cvals[1] = vals[1]/v;
131     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
132     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
133 #if defined(PRINT_GDET)
134     {
135       PetscViewer viewer;
136       char filename[256];
137       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
138       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
139       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
141       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
142       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
143       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
144       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
145       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
146       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
147     }
148 #endif
149     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
150     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
151   }
152 
153   PetscFunctionReturn(0);
154 }
155 
156 PetscErrorCode PCBDDCNedelecSupport(PC pc)
157 {
158   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
159   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
160   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
161   Vec                    tvec;
162   PetscSF                sfv;
163   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
164   MPI_Comm               comm;
165   IS                     lned,primals,allprimals,nedfieldlocal;
166   IS                     *eedges,*extrows,*extcols,*alleedges;
167   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
168   PetscScalar            *vals,*work;
169   PetscReal              *rwork;
170   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
171   PetscInt               ne,nv,Lv,order,n,field;
172   PetscInt               n_neigh,*neigh,*n_shared,**shared;
173   PetscInt               i,j,extmem,cum,maxsize,nee;
174   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
175   PetscInt               *sfvleaves,*sfvroots;
176   PetscInt               *corners,*cedges;
177   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
178 #if defined(PETSC_USE_DEBUG)
179   PetscInt               *emarks;
180 #endif
181   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
182   PetscErrorCode         ierr;
183 
184   PetscFunctionBegin;
185   /* If the discrete gradient is defined for a subset of dofs and global is true,
186      it assumes G is given in global ordering for all the dofs.
187      Otherwise, the ordering is global for the Nedelec field */
188   order      = pcbddc->nedorder;
189   conforming = pcbddc->conforming;
190   field      = pcbddc->nedfield;
191   global     = pcbddc->nedglobal;
192   setprimal  = PETSC_FALSE;
193   print      = PETSC_FALSE;
194   singular   = PETSC_FALSE;
195 
196   /* Command line customization */
197   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
201   /* print debug info TODO: to be removed */
202   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
203   ierr = PetscOptionsEnd();CHKERRQ(ierr);
204 
205   /* Return if there are no edges in the decomposition and the problem is not singular */
206   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
207   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
208   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
209   if (!singular) {
210     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
211     lrc[0] = PETSC_FALSE;
212     for (i=0;i<n;i++) {
213       if (PetscRealPart(vals[i]) > 2.) {
214         lrc[0] = PETSC_TRUE;
215         break;
216       }
217     }
218     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
219     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
220     if (!lrc[1]) PetscFunctionReturn(0);
221   }
222 
223   /* Get Nedelec field */
224   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);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
237     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   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);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
324   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     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);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
638   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
836       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             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]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         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",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1183     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       const PetscScalar *data;
1281       const PetscInt    *rows,*cols;
1282       PetscInt          nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1295       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);
1296       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);
1297       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize,*gidxs;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1491   }
1492 
1493   /* compute local quad vec */
1494   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1495   if (!transpose) {
1496     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1497   } else {
1498     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1499   }
1500   ierr = VecSet(p,1.);CHKERRQ(ierr);
1501   if (!transpose) {
1502     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1503   } else {
1504     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1505   }
1506   if (vl2l) {
1507     Mat        lA;
1508     VecScatter sc;
1509 
1510     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1511     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1512     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1513     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1516   } else {
1517     vins = v;
1518   }
1519   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1520   ierr = VecDestroy(&p);CHKERRQ(ierr);
1521 
1522   /* insert in global quadrature vecs */
1523   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1524   for (i=0;i<n_neigh;i++) {
1525     const PetscInt    *idxs;
1526     PetscInt          idx,nn,j;
1527 
1528     idxs = shared[i];
1529     nn   = n_shared[i];
1530     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1531     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1532     idx  = -(idx+1);
1533     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1534     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614 
1615       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1616       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1617         PetscInt bs;
1618 
1619         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1620         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1621         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1622         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1623       }
1624       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1625       pcbddc->n_ISForDofs = 0;
1626       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1627     }
1628   } else {
1629     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1630       DM dm;
1631 
1632       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1633       if (!dm) {
1634         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1635       }
1636       if (dm) {
1637         IS      *fields;
1638         PetscInt nf,i;
1639 
1640         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1641         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1642         for (i=0;i<nf;i++) {
1643           PetscInt bs;
1644 
1645           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1646           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1647           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1648           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1649         }
1650         ierr = PetscFree(fields);CHKERRQ(ierr);
1651         pcbddc->n_ISForDofsLocal = nf;
1652       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1653         PetscContainer   c;
1654 
1655         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1656         if (c) {
1657           MatISLocalFields lf;
1658           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1659           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1660         } else { /* fallback, create the default fields if bs > 1 */
1661           PetscInt i, n = matis->A->rmap->n;
1662           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1663           if (i > 1) {
1664             pcbddc->n_ISForDofsLocal = i;
1665             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1666             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1667               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1668             }
1669           }
1670         }
1671       }
1672     } else {
1673       PetscInt i;
1674       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1675         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1676       }
1677     }
1678   }
1679 
1680 boundary:
1681   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1683   } else if (pcbddc->DirichletBoundariesLocal) {
1684     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1685   }
1686   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1687     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1688   } else if (pcbddc->NeumannBoundariesLocal) {
1689     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1690   }
1691   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1692     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1693   }
1694   ierr = VecDestroy(&global);CHKERRQ(ierr);
1695   ierr = VecDestroy(&local);CHKERRQ(ierr);
1696   /* detect local disconnected subdomains if requested (use matis->A) */
1697   if (pcbddc->detect_disconnected) {
1698     IS        primalv = NULL;
1699     PetscInt  i;
1700     PetscBool filter = pcbddc->detect_disconnected_filter;
1701 
1702     for (i=0;i<pcbddc->n_local_subs;i++) {
1703       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1704     }
1705     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1706     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1707     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1708     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1709   }
1710   /* early stage corner detection */
1711   {
1712     DM dm;
1713 
1714     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1715     if (!dm) {
1716       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1717     }
1718     if (dm) {
1719       PetscBool isda;
1720 
1721       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1722       if (isda) {
1723         ISLocalToGlobalMapping l2l;
1724         IS                     corners;
1725         Mat                    lA;
1726         PetscBool              gl,lo;
1727 
1728         {
1729           Vec               cvec;
1730           const PetscScalar *coords;
1731           PetscInt          dof,n,cdim;
1732           PetscBool         memc = PETSC_TRUE;
1733 
1734           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1735           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1736           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1737           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1738           n   /= cdim;
1739           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1740           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1741           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1742 #if defined(PETSC_USE_COMPLEX)
1743           memc = PETSC_FALSE;
1744 #endif
1745           if (dof != 1) memc = PETSC_FALSE;
1746           if (memc) {
1747             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1748           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1749             PetscReal *bcoords = pcbddc->mat_graph->coords;
1750             PetscInt  i, b, d;
1751 
1752             for (i=0;i<n;i++) {
1753               for (b=0;b<dof;b++) {
1754                 for (d=0;d<cdim;d++) {
1755                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1756                 }
1757               }
1758             }
1759           }
1760           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1761           pcbddc->mat_graph->cdim  = cdim;
1762           pcbddc->mat_graph->cnloc = dof*n;
1763           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1764         }
1765         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1766         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1767         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1768         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1769         lo   = (PetscBool)(l2l && corners);
1770         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1771         if (gl) { /* From PETSc's DMDA */
1772           const PetscInt    *idx;
1773           PetscInt          dof,bs,*idxout,n;
1774 
1775           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1776           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1777           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1778           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1779           if (bs == dof) {
1780             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1781             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1782           } else { /* the original DMDA local-to-local map have been modified */
1783             PetscInt i,d;
1784 
1785             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1786             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1787             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1788 
1789             bs = 1;
1790             n *= dof;
1791           }
1792           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1793           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1794           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1795           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1796           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1797           pcbddc->corner_selected  = PETSC_TRUE;
1798           pcbddc->corner_selection = PETSC_TRUE;
1799         }
1800         if (corners) {
1801           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1802         }
1803       }
1804     }
1805   }
1806   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1807     DM dm;
1808 
1809     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1810     if (!dm) {
1811       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1812     }
1813     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1814       Vec            vcoords;
1815       PetscSection   section;
1816       PetscReal      *coords;
1817       PetscInt       d,cdim,nl,nf,**ctxs;
1818       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1819 
1820       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1821       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1822       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1823       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1824       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1825       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1826       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1827       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1828       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1829       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1830       for (d=0;d<cdim;d++) {
1831         PetscInt          i;
1832         const PetscScalar *v;
1833 
1834         for (i=0;i<nf;i++) ctxs[i][0] = d;
1835         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1836         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1837         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1838         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1839       }
1840       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1841       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1842       ierr = PetscFree(coords);CHKERRQ(ierr);
1843       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1844       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1845     }
1846   }
1847   PetscFunctionReturn(0);
1848 }
1849 
1850 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1851 {
1852   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1853   PetscErrorCode  ierr;
1854   IS              nis;
1855   const PetscInt  *idxs;
1856   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1857   PetscBool       *ld;
1858 
1859   PetscFunctionBegin;
1860   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1861   if (mop == MPI_LAND) {
1862     /* init rootdata with true */
1863     ld   = (PetscBool*) matis->sf_rootdata;
1864     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1865   } else {
1866     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1867   }
1868   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1869   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1870   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1871   ld   = (PetscBool*) matis->sf_leafdata;
1872   for (i=0;i<nd;i++)
1873     if (-1 < idxs[i] && idxs[i] < n)
1874       ld[idxs[i]] = PETSC_TRUE;
1875   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1876   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1877   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1878   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1879   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1880   if (mop == MPI_LAND) {
1881     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1882   } else {
1883     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1884   }
1885   for (i=0,nnd=0;i<n;i++)
1886     if (ld[i])
1887       nidxs[nnd++] = i;
1888   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1889   ierr = ISDestroy(is);CHKERRQ(ierr);
1890   *is  = nis;
1891   PetscFunctionReturn(0);
1892 }
1893 
1894 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1895 {
1896   PC_IS             *pcis = (PC_IS*)(pc->data);
1897   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1898   PetscErrorCode    ierr;
1899 
1900   PetscFunctionBegin;
1901   if (!pcbddc->benign_have_null) {
1902     PetscFunctionReturn(0);
1903   }
1904   if (pcbddc->ChangeOfBasisMatrix) {
1905     Vec swap;
1906 
1907     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1908     swap = pcbddc->work_change;
1909     pcbddc->work_change = r;
1910     r = swap;
1911   }
1912   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1913   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1914   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1915   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1916   ierr = VecSet(z,0.);CHKERRQ(ierr);
1917   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1918   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1919   if (pcbddc->ChangeOfBasisMatrix) {
1920     pcbddc->work_change = r;
1921     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1922     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1923   }
1924   PetscFunctionReturn(0);
1925 }
1926 
1927 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1928 {
1929   PCBDDCBenignMatMult_ctx ctx;
1930   PetscErrorCode          ierr;
1931   PetscBool               apply_right,apply_left,reset_x;
1932 
1933   PetscFunctionBegin;
1934   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1935   if (transpose) {
1936     apply_right = ctx->apply_left;
1937     apply_left = ctx->apply_right;
1938   } else {
1939     apply_right = ctx->apply_right;
1940     apply_left = ctx->apply_left;
1941   }
1942   reset_x = PETSC_FALSE;
1943   if (apply_right) {
1944     const PetscScalar *ax;
1945     PetscInt          nl,i;
1946 
1947     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1948     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1949     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1950     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1951     for (i=0;i<ctx->benign_n;i++) {
1952       PetscScalar    sum,val;
1953       const PetscInt *idxs;
1954       PetscInt       nz,j;
1955       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1956       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1957       sum = 0.;
1958       if (ctx->apply_p0) {
1959         val = ctx->work[idxs[nz-1]];
1960         for (j=0;j<nz-1;j++) {
1961           sum += ctx->work[idxs[j]];
1962           ctx->work[idxs[j]] += val;
1963         }
1964       } else {
1965         for (j=0;j<nz-1;j++) {
1966           sum += ctx->work[idxs[j]];
1967         }
1968       }
1969       ctx->work[idxs[nz-1]] -= sum;
1970       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1971     }
1972     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1973     reset_x = PETSC_TRUE;
1974   }
1975   if (transpose) {
1976     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1977   } else {
1978     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1979   }
1980   if (reset_x) {
1981     ierr = VecResetArray(x);CHKERRQ(ierr);
1982   }
1983   if (apply_left) {
1984     PetscScalar *ay;
1985     PetscInt    i;
1986 
1987     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1988     for (i=0;i<ctx->benign_n;i++) {
1989       PetscScalar    sum,val;
1990       const PetscInt *idxs;
1991       PetscInt       nz,j;
1992       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1993       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1994       val = -ay[idxs[nz-1]];
1995       if (ctx->apply_p0) {
1996         sum = 0.;
1997         for (j=0;j<nz-1;j++) {
1998           sum += ay[idxs[j]];
1999           ay[idxs[j]] += val;
2000         }
2001         ay[idxs[nz-1]] += sum;
2002       } else {
2003         for (j=0;j<nz-1;j++) {
2004           ay[idxs[j]] += val;
2005         }
2006         ay[idxs[nz-1]] = 0.;
2007       }
2008       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2009     }
2010     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2011   }
2012   PetscFunctionReturn(0);
2013 }
2014 
2015 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2016 {
2017   PetscErrorCode ierr;
2018 
2019   PetscFunctionBegin;
2020   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2021   PetscFunctionReturn(0);
2022 }
2023 
2024 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2025 {
2026   PetscErrorCode ierr;
2027 
2028   PetscFunctionBegin;
2029   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2030   PetscFunctionReturn(0);
2031 }
2032 
2033 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2034 {
2035   PC_IS                   *pcis = (PC_IS*)pc->data;
2036   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2037   PCBDDCBenignMatMult_ctx ctx;
2038   PetscErrorCode          ierr;
2039 
2040   PetscFunctionBegin;
2041   if (!restore) {
2042     Mat                A_IB,A_BI;
2043     PetscScalar        *work;
2044     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2045 
2046     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2047     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2048     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2049     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2050     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2051     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2052     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2053     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2054     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2055     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2056     ctx->apply_left = PETSC_TRUE;
2057     ctx->apply_right = PETSC_FALSE;
2058     ctx->apply_p0 = PETSC_FALSE;
2059     ctx->benign_n = pcbddc->benign_n;
2060     if (reuse) {
2061       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2062       ctx->free = PETSC_FALSE;
2063     } else { /* TODO: could be optimized for successive solves */
2064       ISLocalToGlobalMapping N_to_D;
2065       PetscInt               i;
2066 
2067       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2068       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2069       for (i=0;i<pcbddc->benign_n;i++) {
2070         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2071       }
2072       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2073       ctx->free = PETSC_TRUE;
2074     }
2075     ctx->A = pcis->A_IB;
2076     ctx->work = work;
2077     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2078     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2079     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2080     pcis->A_IB = A_IB;
2081 
2082     /* A_BI as A_IB^T */
2083     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2084     pcbddc->benign_original_mat = pcis->A_BI;
2085     pcis->A_BI = A_BI;
2086   } else {
2087     if (!pcbddc->benign_original_mat) {
2088       PetscFunctionReturn(0);
2089     }
2090     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2091     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2092     pcis->A_IB = ctx->A;
2093     ctx->A = NULL;
2094     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2095     pcis->A_BI = pcbddc->benign_original_mat;
2096     pcbddc->benign_original_mat = NULL;
2097     if (ctx->free) {
2098       PetscInt i;
2099       for (i=0;i<ctx->benign_n;i++) {
2100         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2101       }
2102       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2103     }
2104     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2105     ierr = PetscFree(ctx);CHKERRQ(ierr);
2106   }
2107   PetscFunctionReturn(0);
2108 }
2109 
2110 /* used just in bddc debug mode */
2111 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2112 {
2113   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2114   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2115   Mat            An;
2116   PetscErrorCode ierr;
2117 
2118   PetscFunctionBegin;
2119   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2120   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2121   if (is1) {
2122     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2123     ierr = MatDestroy(&An);CHKERRQ(ierr);
2124   } else {
2125     *B = An;
2126   }
2127   PetscFunctionReturn(0);
2128 }
2129 
2130 /* TODO: add reuse flag */
2131 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2132 {
2133   Mat            Bt;
2134   PetscScalar    *a,*bdata;
2135   const PetscInt *ii,*ij;
2136   PetscInt       m,n,i,nnz,*bii,*bij;
2137   PetscBool      flg_row;
2138   PetscErrorCode ierr;
2139 
2140   PetscFunctionBegin;
2141   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2142   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2143   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2144   nnz = n;
2145   for (i=0;i<ii[n];i++) {
2146     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2147   }
2148   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2149   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2150   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2151   nnz = 0;
2152   bii[0] = 0;
2153   for (i=0;i<n;i++) {
2154     PetscInt j;
2155     for (j=ii[i];j<ii[i+1];j++) {
2156       PetscScalar entry = a[j];
2157       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2158         bij[nnz] = ij[j];
2159         bdata[nnz] = entry;
2160         nnz++;
2161       }
2162     }
2163     bii[i+1] = nnz;
2164   }
2165   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2166   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2167   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2168   {
2169     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2170     b->free_a = PETSC_TRUE;
2171     b->free_ij = PETSC_TRUE;
2172   }
2173   if (*B == A) {
2174     ierr = MatDestroy(&A);CHKERRQ(ierr);
2175   }
2176   *B = Bt;
2177   PetscFunctionReturn(0);
2178 }
2179 
2180 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2181 {
2182   Mat                    B = NULL;
2183   DM                     dm;
2184   IS                     is_dummy,*cc_n;
2185   ISLocalToGlobalMapping l2gmap_dummy;
2186   PCBDDCGraph            graph;
2187   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2188   PetscInt               i,n;
2189   PetscInt               *xadj,*adjncy;
2190   PetscBool              isplex = PETSC_FALSE;
2191   PetscErrorCode         ierr;
2192 
2193   PetscFunctionBegin;
2194   if (ncc) *ncc = 0;
2195   if (cc) *cc = NULL;
2196   if (primalv) *primalv = NULL;
2197   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2198   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2199   if (!dm) {
2200     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2201   }
2202   if (dm) {
2203     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2204   }
2205   if (filter) isplex = PETSC_FALSE;
2206 
2207   if (isplex) { /* this code has been modified from plexpartition.c */
2208     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2209     PetscInt      *adj = NULL;
2210     IS             cellNumbering;
2211     const PetscInt *cellNum;
2212     PetscBool      useCone, useClosure;
2213     PetscSection   section;
2214     PetscSegBuffer adjBuffer;
2215     PetscSF        sfPoint;
2216     PetscErrorCode ierr;
2217 
2218     PetscFunctionBegin;
2219     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2220     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2221     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2222     /* Build adjacency graph via a section/segbuffer */
2223     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2224     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2225     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2226     /* Always use FVM adjacency to create partitioner graph */
2227     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2228     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2229     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2230     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2231     for (n = 0, p = pStart; p < pEnd; p++) {
2232       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2233       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2234       adjSize = PETSC_DETERMINE;
2235       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2236       for (a = 0; a < adjSize; ++a) {
2237         const PetscInt point = adj[a];
2238         if (pStart <= point && point < pEnd) {
2239           PetscInt *PETSC_RESTRICT pBuf;
2240           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2241           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2242           *pBuf = point;
2243         }
2244       }
2245       n++;
2246     }
2247     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2248     /* Derive CSR graph from section/segbuffer */
2249     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2250     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2251     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2252     for (idx = 0, p = pStart; p < pEnd; p++) {
2253       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2254       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2255     }
2256     xadj[n] = size;
2257     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2258     /* Clean up */
2259     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2260     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2261     ierr = PetscFree(adj);CHKERRQ(ierr);
2262     graph->xadj = xadj;
2263     graph->adjncy = adjncy;
2264   } else {
2265     Mat       A;
2266     PetscBool isseqaij, flg_row;
2267 
2268     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2269     if (!A->rmap->N || !A->cmap->N) {
2270       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2271       PetscFunctionReturn(0);
2272     }
2273     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2274     if (!isseqaij && filter) {
2275       PetscBool isseqdense;
2276 
2277       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2278       if (!isseqdense) {
2279         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2280       } else { /* TODO: rectangular case and LDA */
2281         PetscScalar *array;
2282         PetscReal   chop=1.e-6;
2283 
2284         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2285         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2286         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2287         for (i=0;i<n;i++) {
2288           PetscInt j;
2289           for (j=i+1;j<n;j++) {
2290             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2291             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2292             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2293           }
2294         }
2295         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2296         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2297       }
2298     } else {
2299       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2300       B = A;
2301     }
2302     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2303 
2304     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2305     if (filter) {
2306       PetscScalar *data;
2307       PetscInt    j,cum;
2308 
2309       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2310       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2311       cum = 0;
2312       for (i=0;i<n;i++) {
2313         PetscInt t;
2314 
2315         for (j=xadj[i];j<xadj[i+1];j++) {
2316           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2317             continue;
2318           }
2319           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2320         }
2321         t = xadj_filtered[i];
2322         xadj_filtered[i] = cum;
2323         cum += t;
2324       }
2325       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2326       graph->xadj = xadj_filtered;
2327       graph->adjncy = adjncy_filtered;
2328     } else {
2329       graph->xadj = xadj;
2330       graph->adjncy = adjncy;
2331     }
2332   }
2333   /* compute local connected components using PCBDDCGraph */
2334   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2335   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2336   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2337   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2338   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2339   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2340   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2341 
2342   /* partial clean up */
2343   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2344   if (B) {
2345     PetscBool flg_row;
2346     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2347     ierr = MatDestroy(&B);CHKERRQ(ierr);
2348   }
2349   if (isplex) {
2350     ierr = PetscFree(xadj);CHKERRQ(ierr);
2351     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2352   }
2353 
2354   /* get back data */
2355   if (isplex) {
2356     if (ncc) *ncc = graph->ncc;
2357     if (cc || primalv) {
2358       Mat          A;
2359       PetscBT      btv,btvt;
2360       PetscSection subSection;
2361       PetscInt     *ids,cum,cump,*cids,*pids;
2362 
2363       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2364       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2365       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2366       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2367       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2368 
2369       cids[0] = 0;
2370       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2371         PetscInt j;
2372 
2373         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2374         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2375           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2376 
2377           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2378           for (k = 0; k < 2*size; k += 2) {
2379             PetscInt s, pp, p = closure[k], off, dof, cdof;
2380 
2381             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2382             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2383             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2384             for (s = 0; s < dof-cdof; s++) {
2385               if (PetscBTLookupSet(btvt,off+s)) continue;
2386               if (!PetscBTLookup(btv,off+s)) {
2387                 ids[cum++] = off+s;
2388               } else { /* cross-vertex */
2389                 pids[cump++] = off+s;
2390               }
2391             }
2392             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2393             if (pp != p) {
2394               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2395               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2396               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2397               for (s = 0; s < dof-cdof; s++) {
2398                 if (PetscBTLookupSet(btvt,off+s)) continue;
2399                 if (!PetscBTLookup(btv,off+s)) {
2400                   ids[cum++] = off+s;
2401                 } else { /* cross-vertex */
2402                   pids[cump++] = off+s;
2403                 }
2404               }
2405             }
2406           }
2407           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2408         }
2409         cids[i+1] = cum;
2410         /* mark dofs as already assigned */
2411         for (j = cids[i]; j < cids[i+1]; j++) {
2412           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2413         }
2414       }
2415       if (cc) {
2416         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2417         for (i = 0; i < graph->ncc; i++) {
2418           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2419         }
2420         *cc = cc_n;
2421       }
2422       if (primalv) {
2423         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2424       }
2425       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2426       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2427       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2428     }
2429   } else {
2430     if (ncc) *ncc = graph->ncc;
2431     if (cc) {
2432       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2433       for (i=0;i<graph->ncc;i++) {
2434         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);
2435       }
2436       *cc = cc_n;
2437     }
2438   }
2439   /* clean up graph */
2440   graph->xadj = 0;
2441   graph->adjncy = 0;
2442   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2443   PetscFunctionReturn(0);
2444 }
2445 
2446 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2447 {
2448   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2449   PC_IS*         pcis = (PC_IS*)(pc->data);
2450   IS             dirIS = NULL;
2451   PetscInt       i;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2456   if (zerodiag) {
2457     Mat            A;
2458     Vec            vec3_N;
2459     PetscScalar    *vals;
2460     const PetscInt *idxs;
2461     PetscInt       nz,*count;
2462 
2463     /* p0 */
2464     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2465     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2466     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2467     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2468     for (i=0;i<nz;i++) vals[i] = 1.;
2469     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2470     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2471     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2472     /* v_I */
2473     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2474     for (i=0;i<nz;i++) vals[i] = 0.;
2475     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2476     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2477     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2478     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2479     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2480     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2481     if (dirIS) {
2482       PetscInt n;
2483 
2484       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2485       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2486       for (i=0;i<n;i++) vals[i] = 0.;
2487       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2488       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2489     }
2490     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2491     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2492     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2493     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2494     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2495     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2496     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2497     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]));
2498     ierr = PetscFree(vals);CHKERRQ(ierr);
2499     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2500 
2501     /* there should not be any pressure dofs lying on the interface */
2502     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2503     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2504     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2505     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2506     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2507     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]);
2508     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2509     ierr = PetscFree(count);CHKERRQ(ierr);
2510   }
2511   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2512 
2513   /* check PCBDDCBenignGetOrSetP0 */
2514   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2515   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2516   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2517   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2518   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2519   for (i=0;i<pcbddc->benign_n;i++) {
2520     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2521     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2522   }
2523   PetscFunctionReturn(0);
2524 }
2525 
2526 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2527 {
2528   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2529   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2530   PetscInt       nz,n,benign_n,bsp = 1;
2531   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2532   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2533   PetscErrorCode ierr;
2534 
2535   PetscFunctionBegin;
2536   if (reuse) goto project_b0;
2537   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2538   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2539   for (n=0;n<pcbddc->benign_n;n++) {
2540     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2541   }
2542   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2543   has_null_pressures = PETSC_TRUE;
2544   have_null = PETSC_TRUE;
2545   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2546      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2547      Checks if all the pressure dofs in each subdomain have a zero diagonal
2548      If not, a change of basis on pressures is not needed
2549      since the local Schur complements are already SPD
2550   */
2551   if (pcbddc->n_ISForDofsLocal) {
2552     IS        iP = NULL;
2553     PetscInt  p,*pp;
2554     PetscBool flg;
2555 
2556     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2557     n    = pcbddc->n_ISForDofsLocal;
2558     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2559     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2560     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2561     if (!flg) {
2562       n = 1;
2563       pp[0] = pcbddc->n_ISForDofsLocal-1;
2564     }
2565 
2566     bsp = 0;
2567     for (p=0;p<n;p++) {
2568       PetscInt bs;
2569 
2570       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2571       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2572       bsp += bs;
2573     }
2574     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2575     bsp  = 0;
2576     for (p=0;p<n;p++) {
2577       const PetscInt *idxs;
2578       PetscInt       b,bs,npl,*bidxs;
2579 
2580       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2581       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2582       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2583       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2584       for (b=0;b<bs;b++) {
2585         PetscInt i;
2586 
2587         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2588         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2589         bsp++;
2590       }
2591       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2592       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2593     }
2594     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2595 
2596     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2597     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2598     if (iP) {
2599       IS newpressures;
2600 
2601       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2602       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2603       pressures = newpressures;
2604     }
2605     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2606     if (!sorted) {
2607       ierr = ISSort(pressures);CHKERRQ(ierr);
2608     }
2609     ierr = PetscFree(pp);CHKERRQ(ierr);
2610   }
2611 
2612   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2613   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2614   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2615   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2616   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2617   if (!sorted) {
2618     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2619   }
2620   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2621   zerodiag_save = zerodiag;
2622   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2623   if (!nz) {
2624     if (n) have_null = PETSC_FALSE;
2625     has_null_pressures = PETSC_FALSE;
2626     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2627   }
2628   recompute_zerodiag = PETSC_FALSE;
2629 
2630   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2631   zerodiag_subs    = NULL;
2632   benign_n         = 0;
2633   n_interior_dofs  = 0;
2634   interior_dofs    = NULL;
2635   nneu             = 0;
2636   if (pcbddc->NeumannBoundariesLocal) {
2637     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2638   }
2639   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2640   if (checkb) { /* need to compute interior nodes */
2641     PetscInt n,i,j;
2642     PetscInt n_neigh,*neigh,*n_shared,**shared;
2643     PetscInt *iwork;
2644 
2645     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2646     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2647     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2648     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2649     for (i=1;i<n_neigh;i++)
2650       for (j=0;j<n_shared[i];j++)
2651           iwork[shared[i][j]] += 1;
2652     for (i=0;i<n;i++)
2653       if (!iwork[i])
2654         interior_dofs[n_interior_dofs++] = i;
2655     ierr = PetscFree(iwork);CHKERRQ(ierr);
2656     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2657   }
2658   if (has_null_pressures) {
2659     IS             *subs;
2660     PetscInt       nsubs,i,j,nl;
2661     const PetscInt *idxs;
2662     PetscScalar    *array;
2663     Vec            *work;
2664     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2665 
2666     subs  = pcbddc->local_subs;
2667     nsubs = pcbddc->n_local_subs;
2668     /* 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) */
2669     if (checkb) {
2670       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2671       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2672       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2673       /* work[0] = 1_p */
2674       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2675       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2676       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2677       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2678       /* work[0] = 1_v */
2679       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2680       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2681       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2682       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2683       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2684     }
2685 
2686     if (nsubs > 1 || bsp > 1) {
2687       IS       *is;
2688       PetscInt b,totb;
2689 
2690       totb  = bsp;
2691       is    = bsp > 1 ? bzerodiag : &zerodiag;
2692       nsubs = PetscMax(nsubs,1);
2693       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2694       for (b=0;b<totb;b++) {
2695         for (i=0;i<nsubs;i++) {
2696           ISLocalToGlobalMapping l2g;
2697           IS                     t_zerodiag_subs;
2698           PetscInt               nl;
2699 
2700           if (subs) {
2701             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2702           } else {
2703             IS tis;
2704 
2705             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2706             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2707             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2708             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2709           }
2710           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2711           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2712           if (nl) {
2713             PetscBool valid = PETSC_TRUE;
2714 
2715             if (checkb) {
2716               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2717               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2718               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2719               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2720               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2721               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2722               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2723               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2724               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2725               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2726               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2727               for (j=0;j<n_interior_dofs;j++) {
2728                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2729                   valid = PETSC_FALSE;
2730                   break;
2731                 }
2732               }
2733               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2734             }
2735             if (valid && nneu) {
2736               const PetscInt *idxs;
2737               PetscInt       nzb;
2738 
2739               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2740               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2741               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2742               if (nzb) valid = PETSC_FALSE;
2743             }
2744             if (valid && pressures) {
2745               IS       t_pressure_subs,tmp;
2746               PetscInt i1,i2;
2747 
2748               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2749               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2750               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2751               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2752               if (i2 != i1) valid = PETSC_FALSE;
2753               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2754               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2755             }
2756             if (valid) {
2757               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2758               benign_n++;
2759             } else recompute_zerodiag = PETSC_TRUE;
2760           }
2761           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2762           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2763         }
2764       }
2765     } else { /* there's just one subdomain (or zero if they have not been detected */
2766       PetscBool valid = PETSC_TRUE;
2767 
2768       if (nneu) valid = PETSC_FALSE;
2769       if (valid && pressures) {
2770         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2771       }
2772       if (valid && checkb) {
2773         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2774         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2775         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2776         for (j=0;j<n_interior_dofs;j++) {
2777           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2778             valid = PETSC_FALSE;
2779             break;
2780           }
2781         }
2782         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2783       }
2784       if (valid) {
2785         benign_n = 1;
2786         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2787         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2788         zerodiag_subs[0] = zerodiag;
2789       }
2790     }
2791     if (checkb) {
2792       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2793     }
2794   }
2795   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2796 
2797   if (!benign_n) {
2798     PetscInt n;
2799 
2800     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2801     recompute_zerodiag = PETSC_FALSE;
2802     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2803     if (n) have_null = PETSC_FALSE;
2804   }
2805 
2806   /* final check for null pressures */
2807   if (zerodiag && pressures) {
2808     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2809   }
2810 
2811   if (recompute_zerodiag) {
2812     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2813     if (benign_n == 1) {
2814       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2815       zerodiag = zerodiag_subs[0];
2816     } else {
2817       PetscInt i,nzn,*new_idxs;
2818 
2819       nzn = 0;
2820       for (i=0;i<benign_n;i++) {
2821         PetscInt ns;
2822         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2823         nzn += ns;
2824       }
2825       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2826       nzn = 0;
2827       for (i=0;i<benign_n;i++) {
2828         PetscInt ns,*idxs;
2829         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2830         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2831         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2832         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2833         nzn += ns;
2834       }
2835       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2836       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2837     }
2838     have_null = PETSC_FALSE;
2839   }
2840 
2841   /* determines if the coarse solver will be singular or not */
2842   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2843 
2844   /* Prepare matrix to compute no-net-flux */
2845   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2846     Mat                    A,loc_divudotp;
2847     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2848     IS                     row,col,isused = NULL;
2849     PetscInt               M,N,n,st,n_isused;
2850 
2851     if (pressures) {
2852       isused = pressures;
2853     } else {
2854       isused = zerodiag_save;
2855     }
2856     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2857     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2858     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2859     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");
2860     n_isused = 0;
2861     if (isused) {
2862       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2863     }
2864     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2865     st = st-n_isused;
2866     if (n) {
2867       const PetscInt *gidxs;
2868 
2869       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2870       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2871       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2872       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2873       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2874       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2875     } else {
2876       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2877       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2878       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2879     }
2880     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2881     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2882     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2883     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2884     ierr = ISDestroy(&row);CHKERRQ(ierr);
2885     ierr = ISDestroy(&col);CHKERRQ(ierr);
2886     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2887     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2888     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2889     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2890     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2891     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2892     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2893     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2894     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2895     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2896   }
2897   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2898   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2899   if (bzerodiag) {
2900     PetscInt i;
2901 
2902     for (i=0;i<bsp;i++) {
2903       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2904     }
2905     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2906   }
2907   pcbddc->benign_n = benign_n;
2908   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2909 
2910   /* determines if the problem has subdomains with 0 pressure block */
2911   have_null = (PetscBool)(!!pcbddc->benign_n);
2912   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2913 
2914 project_b0:
2915   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2916   /* change of basis and p0 dofs */
2917   if (pcbddc->benign_n) {
2918     PetscInt i,s,*nnz;
2919 
2920     /* local change of basis for pressures */
2921     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2922     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2923     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2924     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2925     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2926     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2927     for (i=0;i<pcbddc->benign_n;i++) {
2928       const PetscInt *idxs;
2929       PetscInt       nzs,j;
2930 
2931       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2932       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2933       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2934       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2935       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2936     }
2937     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2938     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2939     ierr = PetscFree(nnz);CHKERRQ(ierr);
2940     /* set identity by default */
2941     for (i=0;i<n;i++) {
2942       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2943     }
2944     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2945     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2946     /* set change on pressures */
2947     for (s=0;s<pcbddc->benign_n;s++) {
2948       PetscScalar    *array;
2949       const PetscInt *idxs;
2950       PetscInt       nzs;
2951 
2952       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2953       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2954       for (i=0;i<nzs-1;i++) {
2955         PetscScalar vals[2];
2956         PetscInt    cols[2];
2957 
2958         cols[0] = idxs[i];
2959         cols[1] = idxs[nzs-1];
2960         vals[0] = 1.;
2961         vals[1] = 1.;
2962         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2963       }
2964       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2965       for (i=0;i<nzs-1;i++) array[i] = -1.;
2966       array[nzs-1] = 1.;
2967       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2968       /* store local idxs for p0 */
2969       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2970       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2971       ierr = PetscFree(array);CHKERRQ(ierr);
2972     }
2973     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2974     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975 
2976     /* project if needed */
2977     if (pcbddc->benign_change_explicit) {
2978       Mat M;
2979 
2980       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2981       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2982       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2983       ierr = MatDestroy(&M);CHKERRQ(ierr);
2984     }
2985     /* store global idxs for p0 */
2986     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2987   }
2988   *zerodiaglocal = zerodiag;
2989   PetscFunctionReturn(0);
2990 }
2991 
2992 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2993 {
2994   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2995   PetscScalar    *array;
2996   PetscErrorCode ierr;
2997 
2998   PetscFunctionBegin;
2999   if (!pcbddc->benign_sf) {
3000     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3001     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3002   }
3003   if (get) {
3004     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3005     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3006     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3007     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3008   } else {
3009     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3010     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3011     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3012     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3013   }
3014   PetscFunctionReturn(0);
3015 }
3016 
3017 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3018 {
3019   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3020   PetscErrorCode ierr;
3021 
3022   PetscFunctionBegin;
3023   /* TODO: add error checking
3024     - avoid nested pop (or push) calls.
3025     - cannot push before pop.
3026     - cannot call this if pcbddc->local_mat is NULL
3027   */
3028   if (!pcbddc->benign_n) {
3029     PetscFunctionReturn(0);
3030   }
3031   if (pop) {
3032     if (pcbddc->benign_change_explicit) {
3033       IS       is_p0;
3034       MatReuse reuse;
3035 
3036       /* extract B_0 */
3037       reuse = MAT_INITIAL_MATRIX;
3038       if (pcbddc->benign_B0) {
3039         reuse = MAT_REUSE_MATRIX;
3040       }
3041       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3042       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3043       /* remove rows and cols from local problem */
3044       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3045       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3046       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3047       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3048     } else {
3049       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3050       PetscScalar *vals;
3051       PetscInt    i,n,*idxs_ins;
3052 
3053       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3054       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3055       if (!pcbddc->benign_B0) {
3056         PetscInt *nnz;
3057         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3058         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3059         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3060         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3061         for (i=0;i<pcbddc->benign_n;i++) {
3062           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3063           nnz[i] = n - nnz[i];
3064         }
3065         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3066         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3067         ierr = PetscFree(nnz);CHKERRQ(ierr);
3068       }
3069 
3070       for (i=0;i<pcbddc->benign_n;i++) {
3071         PetscScalar *array;
3072         PetscInt    *idxs,j,nz,cum;
3073 
3074         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3075         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3076         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3077         for (j=0;j<nz;j++) vals[j] = 1.;
3078         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3079         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3080         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3081         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3082         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3083         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3084         cum = 0;
3085         for (j=0;j<n;j++) {
3086           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3087             vals[cum] = array[j];
3088             idxs_ins[cum] = j;
3089             cum++;
3090           }
3091         }
3092         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3093         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3094         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3095       }
3096       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3097       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3098       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3099     }
3100   } else { /* push */
3101     if (pcbddc->benign_change_explicit) {
3102       PetscInt i;
3103 
3104       for (i=0;i<pcbddc->benign_n;i++) {
3105         PetscScalar *B0_vals;
3106         PetscInt    *B0_cols,B0_ncol;
3107 
3108         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3109         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3110         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3111         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3112         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3113       }
3114       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3115       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3116     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3117   }
3118   PetscFunctionReturn(0);
3119 }
3120 
3121 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3122 {
3123   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3124   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3125   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3126   PetscBLASInt    *B_iwork,*B_ifail;
3127   PetscScalar     *work,lwork;
3128   PetscScalar     *St,*S,*eigv;
3129   PetscScalar     *Sarray,*Starray;
3130   PetscReal       *eigs,thresh,lthresh,uthresh;
3131   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3132   PetscBool       allocated_S_St;
3133 #if defined(PETSC_USE_COMPLEX)
3134   PetscReal       *rwork;
3135 #endif
3136   PetscErrorCode  ierr;
3137 
3138   PetscFunctionBegin;
3139   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3140   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3141   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3142   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3143 
3144   if (pcbddc->dbg_flag) {
3145     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3146     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3147     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3148     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3149   }
3150 
3151   if (pcbddc->dbg_flag) {
3152     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3153   }
3154 
3155   /* max size of subsets */
3156   mss = 0;
3157   for (i=0;i<sub_schurs->n_subs;i++) {
3158     PetscInt subset_size;
3159 
3160     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3161     mss = PetscMax(mss,subset_size);
3162   }
3163 
3164   /* min/max and threshold */
3165   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3166   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3167   nmax = PetscMax(nmin,nmax);
3168   allocated_S_St = PETSC_FALSE;
3169   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3170     allocated_S_St = PETSC_TRUE;
3171   }
3172 
3173   /* allocate lapack workspace */
3174   cum = cum2 = 0;
3175   maxneigs = 0;
3176   for (i=0;i<sub_schurs->n_subs;i++) {
3177     PetscInt n,subset_size;
3178 
3179     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3180     n = PetscMin(subset_size,nmax);
3181     cum += subset_size;
3182     cum2 += subset_size*n;
3183     maxneigs = PetscMax(maxneigs,n);
3184   }
3185   if (mss) {
3186     if (sub_schurs->is_symmetric) {
3187       PetscBLASInt B_itype = 1;
3188       PetscBLASInt B_N = mss;
3189       PetscReal    zero = 0.0;
3190       PetscReal    eps = 0.0; /* dlamch? */
3191 
3192       B_lwork = -1;
3193       S = NULL;
3194       St = NULL;
3195       eigs = NULL;
3196       eigv = NULL;
3197       B_iwork = NULL;
3198       B_ifail = NULL;
3199 #if defined(PETSC_USE_COMPLEX)
3200       rwork = NULL;
3201 #endif
3202       thresh = 1.0;
3203       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3204 #if defined(PETSC_USE_COMPLEX)
3205       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));
3206 #else
3207       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));
3208 #endif
3209       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3210       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3211     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3212   } else {
3213     lwork = 0;
3214   }
3215 
3216   nv = 0;
3217   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) */
3218     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3219   }
3220   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3221   if (allocated_S_St) {
3222     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3223   }
3224   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3225 #if defined(PETSC_USE_COMPLEX)
3226   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3227 #endif
3228   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3229                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3230                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3231                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3232                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3233   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3234 
3235   maxneigs = 0;
3236   cum = cumarray = 0;
3237   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3238   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3239   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3240     const PetscInt *idxs;
3241 
3242     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3243     for (cum=0;cum<nv;cum++) {
3244       pcbddc->adaptive_constraints_n[cum] = 1;
3245       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3246       pcbddc->adaptive_constraints_data[cum] = 1.0;
3247       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3248       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3249     }
3250     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3251   }
3252 
3253   if (mss) { /* multilevel */
3254     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3255     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3256   }
3257 
3258   lthresh = pcbddc->adaptive_threshold[0];
3259   uthresh = pcbddc->adaptive_threshold[1];
3260   for (i=0;i<sub_schurs->n_subs;i++) {
3261     const PetscInt *idxs;
3262     PetscReal      upper,lower;
3263     PetscInt       j,subset_size,eigs_start = 0;
3264     PetscBLASInt   B_N;
3265     PetscBool      same_data = PETSC_FALSE;
3266     PetscBool      scal = PETSC_FALSE;
3267 
3268     if (pcbddc->use_deluxe_scaling) {
3269       upper = PETSC_MAX_REAL;
3270       lower = uthresh;
3271     } else {
3272       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3273       upper = 1./uthresh;
3274       lower = 0.;
3275     }
3276     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3277     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3278     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3279     /* this is experimental: we assume the dofs have been properly grouped to have
3280        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3281     if (!sub_schurs->is_posdef) {
3282       Mat T;
3283 
3284       for (j=0;j<subset_size;j++) {
3285         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3286           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3287           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3288           ierr = MatDestroy(&T);CHKERRQ(ierr);
3289           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3290           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3291           ierr = MatDestroy(&T);CHKERRQ(ierr);
3292           if (sub_schurs->change_primal_sub) {
3293             PetscInt       nz,k;
3294             const PetscInt *idxs;
3295 
3296             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3297             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3298             for (k=0;k<nz;k++) {
3299               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3300               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3301             }
3302             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3303           }
3304           scal = PETSC_TRUE;
3305           break;
3306         }
3307       }
3308     }
3309 
3310     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3311       if (sub_schurs->is_symmetric) {
3312         PetscInt j,k;
3313         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3314           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3315           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3316         }
3317         for (j=0;j<subset_size;j++) {
3318           for (k=j;k<subset_size;k++) {
3319             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3320             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3321           }
3322         }
3323       } else {
3324         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3325         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3326       }
3327     } else {
3328       S = Sarray + cumarray;
3329       St = Starray + cumarray;
3330     }
3331     /* see if we can save some work */
3332     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3333       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3334     }
3335 
3336     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3337       B_neigs = 0;
3338     } else {
3339       if (sub_schurs->is_symmetric) {
3340         PetscBLASInt B_itype = 1;
3341         PetscBLASInt B_IL, B_IU;
3342         PetscReal    eps = -1.0; /* dlamch? */
3343         PetscInt     nmin_s;
3344         PetscBool    compute_range;
3345 
3346         B_neigs = 0;
3347         compute_range = (PetscBool)!same_data;
3348         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3349 
3350         if (pcbddc->dbg_flag) {
3351           PetscInt nc = 0;
3352 
3353           if (sub_schurs->change_primal_sub) {
3354             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3355           }
3356           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3357         }
3358 
3359         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3360         if (compute_range) {
3361 
3362           /* ask for eigenvalues larger than thresh */
3363           if (sub_schurs->is_posdef) {
3364 #if defined(PETSC_USE_COMPLEX)
3365             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));
3366 #else
3367             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));
3368 #endif
3369             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3370           } else { /* no theory so far, but it works nicely */
3371             PetscInt  recipe = 0,recipe_m = 1;
3372             PetscReal bb[2];
3373 
3374             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3375             switch (recipe) {
3376             case 0:
3377               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3378               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3379 #if defined(PETSC_USE_COMPLEX)
3380               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3381 #else
3382               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3383 #endif
3384               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3385               break;
3386             case 1:
3387               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3388 #if defined(PETSC_USE_COMPLEX)
3389               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3390 #else
3391               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3392 #endif
3393               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3394               if (!scal) {
3395                 PetscBLASInt B_neigs2 = 0;
3396 
3397                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3398                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3399                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3400 #if defined(PETSC_USE_COMPLEX)
3401                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3402 #else
3403                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3404 #endif
3405                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3406                 B_neigs += B_neigs2;
3407               }
3408               break;
3409             case 2:
3410               if (scal) {
3411                 bb[0] = PETSC_MIN_REAL;
3412                 bb[1] = 0;
3413 #if defined(PETSC_USE_COMPLEX)
3414                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3415 #else
3416                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3417 #endif
3418                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3419               } else {
3420                 PetscBLASInt B_neigs2 = 0;
3421                 PetscBool    import = PETSC_FALSE;
3422 
3423                 lthresh = PetscMax(lthresh,0.0);
3424                 if (lthresh > 0.0) {
3425                   bb[0] = PETSC_MIN_REAL;
3426                   bb[1] = lthresh*lthresh;
3427 
3428                   import = PETSC_TRUE;
3429 #if defined(PETSC_USE_COMPLEX)
3430                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3431 #else
3432                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3433 #endif
3434                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3435                 }
3436                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3437                 bb[1] = PETSC_MAX_REAL;
3438                 if (import) {
3439                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3440                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3441                 }
3442 #if defined(PETSC_USE_COMPLEX)
3443                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3444 #else
3445                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3446 #endif
3447                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3448                 B_neigs += B_neigs2;
3449               }
3450               break;
3451             case 3:
3452               if (scal) {
3453                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3454               } else {
3455                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3456               }
3457               if (!scal) {
3458                 bb[0] = uthresh;
3459                 bb[1] = PETSC_MAX_REAL;
3460 #if defined(PETSC_USE_COMPLEX)
3461                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3462 #else
3463                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3464 #endif
3465                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3466               }
3467               if (recipe_m > 0 && B_N - B_neigs > 0) {
3468                 PetscBLASInt B_neigs2 = 0;
3469 
3470                 B_IL = 1;
3471                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3472                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3473                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3474 #if defined(PETSC_USE_COMPLEX)
3475                 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*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3476 #else
3477                 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*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3478 #endif
3479                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3480                 B_neigs += B_neigs2;
3481               }
3482               break;
3483             case 4:
3484               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3485 #if defined(PETSC_USE_COMPLEX)
3486               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3487 #else
3488               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3489 #endif
3490               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3491               {
3492                 PetscBLASInt B_neigs2 = 0;
3493 
3494                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3495                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3496                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3497 #if defined(PETSC_USE_COMPLEX)
3498                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3499 #else
3500                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3501 #endif
3502                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3503                 B_neigs += B_neigs2;
3504               }
3505               break;
3506             case 5: /* same as before: first compute all eigenvalues, then filter */
3507 #if defined(PETSC_USE_COMPLEX)
3508               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3509 #else
3510               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3511 #endif
3512               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3513               {
3514                 PetscInt e,k,ne;
3515                 for (e=0,ne=0;e<B_neigs;e++) {
3516                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3517                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3518                     eigs[ne] = eigs[e];
3519                     ne++;
3520                   }
3521                 }
3522                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3523                 B_neigs = ne;
3524               }
3525               break;
3526             default:
3527               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3528               break;
3529             }
3530           }
3531         } else if (!same_data) { /* this is just to see all the eigenvalues */
3532           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3533           B_IL = 1;
3534 #if defined(PETSC_USE_COMPLEX)
3535           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));
3536 #else
3537           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));
3538 #endif
3539           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3540         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3541           PetscInt k;
3542           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3543           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3544           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3545           nmin = nmax;
3546           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3547           for (k=0;k<nmax;k++) {
3548             eigs[k] = 1./PETSC_SMALL;
3549             eigv[k*(subset_size+1)] = 1.0;
3550           }
3551         }
3552         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3553         if (B_ierr) {
3554           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3555           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);
3556           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);
3557         }
3558 
3559         if (B_neigs > nmax) {
3560           if (pcbddc->dbg_flag) {
3561             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3562           }
3563           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3564           B_neigs = nmax;
3565         }
3566 
3567         nmin_s = PetscMin(nmin,B_N);
3568         if (B_neigs < nmin_s) {
3569           PetscBLASInt B_neigs2 = 0;
3570 
3571           if (pcbddc->use_deluxe_scaling) {
3572             if (scal) {
3573               B_IU = nmin_s;
3574               B_IL = B_neigs + 1;
3575             } else {
3576               B_IL = B_N - nmin_s + 1;
3577               B_IU = B_N - B_neigs;
3578             }
3579           } else {
3580             B_IL = B_neigs + 1;
3581             B_IU = nmin_s;
3582           }
3583           if (pcbddc->dbg_flag) {
3584             ierr = 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);CHKERRQ(ierr);
3585           }
3586           if (sub_schurs->is_symmetric) {
3587             PetscInt j,k;
3588             for (j=0;j<subset_size;j++) {
3589               for (k=j;k<subset_size;k++) {
3590                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3591                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3592               }
3593             }
3594           } else {
3595             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3596             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3597           }
3598           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3599 #if defined(PETSC_USE_COMPLEX)
3600           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));
3601 #else
3602           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));
3603 #endif
3604           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3605           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3606           B_neigs += B_neigs2;
3607         }
3608         if (B_ierr) {
3609           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3610           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);
3611           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);
3612         }
3613         if (pcbddc->dbg_flag) {
3614           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3615           for (j=0;j<B_neigs;j++) {
3616             if (eigs[j] == 0.0) {
3617               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3618             } else {
3619               if (pcbddc->use_deluxe_scaling) {
3620                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3621               } else {
3622                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3623               }
3624             }
3625           }
3626         }
3627       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3628     }
3629     /* change the basis back to the original one */
3630     if (sub_schurs->change) {
3631       Mat change,phi,phit;
3632 
3633       if (pcbddc->dbg_flag > 2) {
3634         PetscInt ii;
3635         for (ii=0;ii<B_neigs;ii++) {
3636           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3637           for (j=0;j<B_N;j++) {
3638 #if defined(PETSC_USE_COMPLEX)
3639             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3640             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3641             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3642 #else
3643             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3644 #endif
3645           }
3646         }
3647       }
3648       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3649       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3650       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3651       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3652       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3653       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3654     }
3655     maxneigs = PetscMax(B_neigs,maxneigs);
3656     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3657     if (B_neigs) {
3658       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3659 
3660       if (pcbddc->dbg_flag > 1) {
3661         PetscInt ii;
3662         for (ii=0;ii<B_neigs;ii++) {
3663           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3664           for (j=0;j<B_N;j++) {
3665 #if defined(PETSC_USE_COMPLEX)
3666             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3667             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3668             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3669 #else
3670             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3671 #endif
3672           }
3673         }
3674       }
3675       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3676       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3677       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3678       cum++;
3679     }
3680     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3681     /* shift for next computation */
3682     cumarray += subset_size*subset_size;
3683   }
3684   if (pcbddc->dbg_flag) {
3685     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3686   }
3687 
3688   if (mss) {
3689     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3690     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3691     /* destroy matrices (junk) */
3692     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3693     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3694   }
3695   if (allocated_S_St) {
3696     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3697   }
3698   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3699 #if defined(PETSC_USE_COMPLEX)
3700   ierr = PetscFree(rwork);CHKERRQ(ierr);
3701 #endif
3702   if (pcbddc->dbg_flag) {
3703     PetscInt maxneigs_r;
3704     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3705     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3706   }
3707   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3708   PetscFunctionReturn(0);
3709 }
3710 
3711 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3712 {
3713   PetscScalar    *coarse_submat_vals;
3714   PetscErrorCode ierr;
3715 
3716   PetscFunctionBegin;
3717   /* Setup local scatters R_to_B and (optionally) R_to_D */
3718   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3719   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3720 
3721   /* Setup local neumann solver ksp_R */
3722   /* PCBDDCSetUpLocalScatters should be called first! */
3723   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3724 
3725   /*
3726      Setup local correction and local part of coarse basis.
3727      Gives back the dense local part of the coarse matrix in column major ordering
3728   */
3729   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3730 
3731   /* Compute total number of coarse nodes and setup coarse solver */
3732   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3733 
3734   /* free */
3735   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3736   PetscFunctionReturn(0);
3737 }
3738 
3739 PetscErrorCode PCBDDCResetCustomization(PC pc)
3740 {
3741   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3742   PetscErrorCode ierr;
3743 
3744   PetscFunctionBegin;
3745   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3746   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3747   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3748   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3749   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3750   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3751   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3753   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3754   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3755   PetscFunctionReturn(0);
3756 }
3757 
3758 PetscErrorCode PCBDDCResetTopography(PC pc)
3759 {
3760   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3761   PetscInt       i;
3762   PetscErrorCode ierr;
3763 
3764   PetscFunctionBegin;
3765   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3766   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3767   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3768   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3769   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3770   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3771   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3772   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3773   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3774   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3775   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3776   for (i=0;i<pcbddc->n_local_subs;i++) {
3777     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3778   }
3779   pcbddc->n_local_subs = 0;
3780   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3781   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3782   pcbddc->graphanalyzed        = PETSC_FALSE;
3783   pcbddc->recompute_topography = PETSC_TRUE;
3784   pcbddc->corner_selected      = PETSC_FALSE;
3785   PetscFunctionReturn(0);
3786 }
3787 
3788 PetscErrorCode PCBDDCResetSolvers(PC pc)
3789 {
3790   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3791   PetscErrorCode ierr;
3792 
3793   PetscFunctionBegin;
3794   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3795   if (pcbddc->coarse_phi_B) {
3796     PetscScalar *array;
3797     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3798     ierr = PetscFree(array);CHKERRQ(ierr);
3799   }
3800   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3801   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3802   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3803   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3804   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3805   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3806   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3807   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3809   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3810   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3811   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3812   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3813   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3814   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3815   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3816   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3817   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3818   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3819   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3820   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3821   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3822   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3823   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3824   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3825   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3826   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3827   if (pcbddc->benign_zerodiag_subs) {
3828     PetscInt i;
3829     for (i=0;i<pcbddc->benign_n;i++) {
3830       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3831     }
3832     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3833   }
3834   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3835   PetscFunctionReturn(0);
3836 }
3837 
3838 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3839 {
3840   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3841   PC_IS          *pcis = (PC_IS*)pc->data;
3842   VecType        impVecType;
3843   PetscInt       n_constraints,n_R,old_size;
3844   PetscErrorCode ierr;
3845 
3846   PetscFunctionBegin;
3847   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3848   n_R = pcis->n - pcbddc->n_vertices;
3849   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3850   /* local work vectors (try to avoid unneeded work)*/
3851   /* R nodes */
3852   old_size = -1;
3853   if (pcbddc->vec1_R) {
3854     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3855   }
3856   if (n_R != old_size) {
3857     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3858     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3859     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3860     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3861     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3862     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3863   }
3864   /* local primal dofs */
3865   old_size = -1;
3866   if (pcbddc->vec1_P) {
3867     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3868   }
3869   if (pcbddc->local_primal_size != old_size) {
3870     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3871     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3872     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3873     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3874   }
3875   /* local explicit constraints */
3876   old_size = -1;
3877   if (pcbddc->vec1_C) {
3878     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3879   }
3880   if (n_constraints && n_constraints != old_size) {
3881     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3882     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3883     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3884     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3885   }
3886   PetscFunctionReturn(0);
3887 }
3888 
3889 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3890 {
3891   PetscErrorCode  ierr;
3892   /* pointers to pcis and pcbddc */
3893   PC_IS*          pcis = (PC_IS*)pc->data;
3894   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3895   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3896   /* submatrices of local problem */
3897   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3898   /* submatrices of local coarse problem */
3899   Mat             S_VV,S_CV,S_VC,S_CC;
3900   /* working matrices */
3901   Mat             C_CR;
3902   /* additional working stuff */
3903   PC              pc_R;
3904   Mat             F,Brhs = NULL;
3905   Vec             dummy_vec;
3906   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3907   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3908   PetscScalar     *work;
3909   PetscInt        *idx_V_B;
3910   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3911   PetscInt        i,n_R,n_D,n_B;
3912   PetscScalar     one=1.0,m_one=-1.0;
3913 
3914   PetscFunctionBegin;
3915   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");
3916   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3917 
3918   /* Set Non-overlapping dimensions */
3919   n_vertices = pcbddc->n_vertices;
3920   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3921   n_B = pcis->n_B;
3922   n_D = pcis->n - n_B;
3923   n_R = pcis->n - n_vertices;
3924 
3925   /* vertices in boundary numbering */
3926   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3927   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3928   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3929 
3930   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3931   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3932   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3933   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3934   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3935   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3936   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3937   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3938   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3939   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3940 
3941   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3942   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3943   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3944   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3945   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3946   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3947   lda_rhs = n_R;
3948   need_benign_correction = PETSC_FALSE;
3949   if (isLU || isILU || isCHOL) {
3950     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3951   } else if (sub_schurs && sub_schurs->reuse_solver) {
3952     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3953     MatFactorType      type;
3954 
3955     F = reuse_solver->F;
3956     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3957     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3958     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3959     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3960   } else {
3961     F = NULL;
3962   }
3963 
3964   /* determine if we can use a sparse right-hand side */
3965   sparserhs = PETSC_FALSE;
3966   if (F) {
3967     MatSolverType solver;
3968 
3969     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3970     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3971   }
3972 
3973   /* allocate workspace */
3974   n = 0;
3975   if (n_constraints) {
3976     n += lda_rhs*n_constraints;
3977   }
3978   if (n_vertices) {
3979     n = PetscMax(2*lda_rhs*n_vertices,n);
3980     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3981   }
3982   if (!pcbddc->symmetric_primal) {
3983     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3984   }
3985   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3986 
3987   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3988   dummy_vec = NULL;
3989   if (need_benign_correction && lda_rhs != n_R && F) {
3990     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3991     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3992     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3993   }
3994 
3995   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3996   if (n_constraints) {
3997     Mat         M3,C_B;
3998     IS          is_aux;
3999     PetscScalar *array,*array2;
4000 
4001     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4002     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4003 
4004     /* Extract constraints on R nodes: C_{CR}  */
4005     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4006     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4007     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4008 
4009     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4010     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4011     if (!sparserhs) {
4012       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4013       for (i=0;i<n_constraints;i++) {
4014         const PetscScalar *row_cmat_values;
4015         const PetscInt    *row_cmat_indices;
4016         PetscInt          size_of_constraint,j;
4017 
4018         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4019         for (j=0;j<size_of_constraint;j++) {
4020           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4021         }
4022         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4023       }
4024       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4025     } else {
4026       Mat tC_CR;
4027 
4028       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4029       if (lda_rhs != n_R) {
4030         PetscScalar *aa;
4031         PetscInt    r,*ii,*jj;
4032         PetscBool   done;
4033 
4034         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4035         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4036         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4037         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4038         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4039         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4040       } else {
4041         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4042         tC_CR = C_CR;
4043       }
4044       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4045       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4046     }
4047     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4048     if (F) {
4049       if (need_benign_correction) {
4050         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4051 
4052         /* rhs is already zero on interior dofs, no need to change the rhs */
4053         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4054       }
4055       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4056       if (need_benign_correction) {
4057         PetscScalar        *marr;
4058         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4059 
4060         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4061         if (lda_rhs != n_R) {
4062           for (i=0;i<n_constraints;i++) {
4063             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4064             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4065             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4066           }
4067         } else {
4068           for (i=0;i<n_constraints;i++) {
4069             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4070             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4071             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4072           }
4073         }
4074         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4075       }
4076     } else {
4077       PetscScalar *marr;
4078 
4079       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4080       for (i=0;i<n_constraints;i++) {
4081         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4082         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4083         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4084         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4085         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4086         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4087       }
4088       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4089     }
4090     if (sparserhs) {
4091       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4092     }
4093     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4094     if (!pcbddc->switch_static) {
4095       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4096       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4097       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4098       for (i=0;i<n_constraints;i++) {
4099         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4100         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4101         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4102         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4103         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4104         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4105       }
4106       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4107       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4108       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4109     } else {
4110       if (lda_rhs != n_R) {
4111         IS dummy;
4112 
4113         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4114         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4115         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4116       } else {
4117         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4118         pcbddc->local_auxmat2 = local_auxmat2_R;
4119       }
4120       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4121     }
4122     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4123     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4124     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4125     if (isCHOL) {
4126       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4127     } else {
4128       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4129     }
4130     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4131     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4132     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4133     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4134     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4135     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4136   }
4137 
4138   /* Get submatrices from subdomain matrix */
4139   if (n_vertices) {
4140     IS is_aux;
4141 
4142     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4143       IS tis;
4144 
4145       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4146       ierr = ISSort(tis);CHKERRQ(ierr);
4147       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4148       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4149     } else {
4150       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4151     }
4152     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4153     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4154     /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4155     ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4156     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4157     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4158   }
4159 
4160   /* Matrix of coarse basis functions (local) */
4161   if (pcbddc->coarse_phi_B) {
4162     PetscInt on_B,on_primal,on_D=n_D;
4163     if (pcbddc->coarse_phi_D) {
4164       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4165     }
4166     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4167     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4168       PetscScalar *marray;
4169 
4170       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4171       ierr = PetscFree(marray);CHKERRQ(ierr);
4172       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4173       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4174       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4175       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4176     }
4177   }
4178 
4179   if (!pcbddc->coarse_phi_B) {
4180     PetscScalar *marr;
4181 
4182     /* memory size */
4183     n = n_B*pcbddc->local_primal_size;
4184     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4185     if (!pcbddc->symmetric_primal) n *= 2;
4186     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4187     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4188     marr += n_B*pcbddc->local_primal_size;
4189     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4190       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4191       marr += n_D*pcbddc->local_primal_size;
4192     }
4193     if (!pcbddc->symmetric_primal) {
4194       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4195       marr += n_B*pcbddc->local_primal_size;
4196       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4197         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4198       }
4199     } else {
4200       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4201       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4202       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4203         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4204         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4205       }
4206     }
4207   }
4208 
4209   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4210   p0_lidx_I = NULL;
4211   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4212     const PetscInt *idxs;
4213 
4214     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4215     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4216     for (i=0;i<pcbddc->benign_n;i++) {
4217       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4218     }
4219     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4220   }
4221 
4222   /* vertices */
4223   if (n_vertices) {
4224     PetscBool restoreavr = PETSC_FALSE;
4225 
4226     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4227 
4228     if (n_R) {
4229       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4230       PetscBLASInt      B_N,B_one = 1;
4231       const PetscScalar *x;
4232       PetscScalar       *y;
4233 
4234       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4235       if (need_benign_correction) {
4236         ISLocalToGlobalMapping RtoN;
4237         IS                     is_p0;
4238         PetscInt               *idxs_p0,n;
4239 
4240         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4241         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4242         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4243         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n);
4244         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4245         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4246         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4247         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4248       }
4249 
4250       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4251       if (!sparserhs || need_benign_correction) {
4252         if (lda_rhs == n_R) {
4253           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4254         } else {
4255           PetscScalar    *av,*array;
4256           const PetscInt *xadj,*adjncy;
4257           PetscInt       n;
4258           PetscBool      flg_row;
4259 
4260           array = work+lda_rhs*n_vertices;
4261           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4262           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4263           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4264           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4265           for (i=0;i<n;i++) {
4266             PetscInt j;
4267             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4268           }
4269           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4270           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4271           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4272         }
4273         if (need_benign_correction) {
4274           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4275           PetscScalar        *marr;
4276 
4277           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4278           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4279 
4280                  | 0 0  0 | (V)
4281              L = | 0 0 -1 | (P-p0)
4282                  | 0 0 -1 | (p0)
4283 
4284           */
4285           for (i=0;i<reuse_solver->benign_n;i++) {
4286             const PetscScalar *vals;
4287             const PetscInt    *idxs,*idxs_zero;
4288             PetscInt          n,j,nz;
4289 
4290             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4291             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4292             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4293             for (j=0;j<n;j++) {
4294               PetscScalar val = vals[j];
4295               PetscInt    k,col = idxs[j];
4296               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4297             }
4298             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4299             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4300           }
4301           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4302         }
4303         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4304         Brhs = A_RV;
4305       } else {
4306         Mat tA_RVT,A_RVT;
4307 
4308         if (!pcbddc->symmetric_primal) {
4309           /* A_RV already scaled by -1 */
4310           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4311         } else {
4312           restoreavr = PETSC_TRUE;
4313           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4314           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4315           A_RVT = A_VR;
4316         }
4317         if (lda_rhs != n_R) {
4318           PetscScalar *aa;
4319           PetscInt    r,*ii,*jj;
4320           PetscBool   done;
4321 
4322           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4323           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4324           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4325           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4326           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4327           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4328         } else {
4329           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4330           tA_RVT = A_RVT;
4331         }
4332         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4333         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4334         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4335       }
4336       if (F) {
4337         /* need to correct the rhs */
4338         if (need_benign_correction) {
4339           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4340           PetscScalar        *marr;
4341 
4342           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4343           if (lda_rhs != n_R) {
4344             for (i=0;i<n_vertices;i++) {
4345               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4346               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4347               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4348             }
4349           } else {
4350             for (i=0;i<n_vertices;i++) {
4351               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4352               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4353               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4354             }
4355           }
4356           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4357         }
4358         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4359         if (restoreavr) {
4360           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4361         }
4362         /* need to correct the solution */
4363         if (need_benign_correction) {
4364           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4365           PetscScalar        *marr;
4366 
4367           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4368           if (lda_rhs != n_R) {
4369             for (i=0;i<n_vertices;i++) {
4370               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4371               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4372               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4373             }
4374           } else {
4375             for (i=0;i<n_vertices;i++) {
4376               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4377               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4378               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4379             }
4380           }
4381           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4382         }
4383       } else {
4384         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4385         for (i=0;i<n_vertices;i++) {
4386           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4387           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4388           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4389           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4390           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4391           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4392         }
4393         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4394       }
4395       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4396       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4397       /* S_VV and S_CV */
4398       if (n_constraints) {
4399         Mat B;
4400 
4401         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4402         for (i=0;i<n_vertices;i++) {
4403           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4404           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4405           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4406           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4407           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4408           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4409         }
4410         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4411         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4412         ierr = MatDestroy(&B);CHKERRQ(ierr);
4413         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4414         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4415         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4416         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4417         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4418         ierr = MatDestroy(&B);CHKERRQ(ierr);
4419       }
4420       if (lda_rhs != n_R) {
4421         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4422         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4423         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4424       }
4425       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4426       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4427       if (need_benign_correction) {
4428         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4429         PetscScalar      *marr,*sums;
4430 
4431         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4432         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4433         for (i=0;i<reuse_solver->benign_n;i++) {
4434           const PetscScalar *vals;
4435           const PetscInt    *idxs,*idxs_zero;
4436           PetscInt          n,j,nz;
4437 
4438           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4439           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4440           for (j=0;j<n_vertices;j++) {
4441             PetscInt k;
4442             sums[j] = 0.;
4443             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4444           }
4445           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4446           for (j=0;j<n;j++) {
4447             PetscScalar val = vals[j];
4448             PetscInt k;
4449             for (k=0;k<n_vertices;k++) {
4450               marr[idxs[j]+k*n_vertices] += val*sums[k];
4451             }
4452           }
4453           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4454           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4455         }
4456         ierr = PetscFree(sums);CHKERRQ(ierr);
4457         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4458         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4459       }
4460       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4461       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4462       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4463       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4464       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4465       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4466       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4467       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4468       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4469     } else {
4470       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4471     }
4472     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4473 
4474     /* coarse basis functions */
4475     for (i=0;i<n_vertices;i++) {
4476       PetscScalar *y;
4477 
4478       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4479       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4480       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4481       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4482       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4483       y[n_B*i+idx_V_B[i]] = 1.0;
4484       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4485       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4486 
4487       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4488         PetscInt j;
4489 
4490         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4491         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4492         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4493         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4494         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4495         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4496         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4497       }
4498       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4499     }
4500     /* if n_R == 0 the object is not destroyed */
4501     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4502   }
4503   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4504 
4505   if (n_constraints) {
4506     Mat B;
4507 
4508     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4509     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4510     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4511     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4512     if (n_vertices) {
4513       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4514         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4515       } else {
4516         Mat S_VCt;
4517 
4518         if (lda_rhs != n_R) {
4519           ierr = MatDestroy(&B);CHKERRQ(ierr);
4520           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4521           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4522         }
4523         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4524         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4525         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4526       }
4527     }
4528     ierr = MatDestroy(&B);CHKERRQ(ierr);
4529     /* coarse basis functions */
4530     for (i=0;i<n_constraints;i++) {
4531       PetscScalar *y;
4532 
4533       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4534       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4535       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4536       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4537       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4538       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4539       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4540       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4541         PetscInt j;
4542 
4543         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4544         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4545         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4546         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4547         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4548         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4549         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4550       }
4551       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4552     }
4553   }
4554   if (n_constraints) {
4555     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4556   }
4557   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4558 
4559   /* coarse matrix entries relative to B_0 */
4560   if (pcbddc->benign_n) {
4561     Mat               B0_B,B0_BPHI;
4562     IS                is_dummy;
4563     const PetscScalar *data;
4564     PetscInt          j;
4565 
4566     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4567     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4568     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4569     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4570     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4571     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4572     for (j=0;j<pcbddc->benign_n;j++) {
4573       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4574       for (i=0;i<pcbddc->local_primal_size;i++) {
4575         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4576         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4577       }
4578     }
4579     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4580     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4581     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4582   }
4583 
4584   /* compute other basis functions for non-symmetric problems */
4585   if (!pcbddc->symmetric_primal) {
4586     Mat         B_V=NULL,B_C=NULL;
4587     PetscScalar *marray;
4588 
4589     if (n_constraints) {
4590       Mat S_CCT,C_CRT;
4591 
4592       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4593       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4594       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4595       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4596       if (n_vertices) {
4597         Mat S_VCT;
4598 
4599         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4600         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4601         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4602       }
4603       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4604     } else {
4605       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4606     }
4607     if (n_vertices && n_R) {
4608       PetscScalar    *av,*marray;
4609       const PetscInt *xadj,*adjncy;
4610       PetscInt       n;
4611       PetscBool      flg_row;
4612 
4613       /* B_V = B_V - A_VR^T */
4614       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4615       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4616       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4617       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4618       for (i=0;i<n;i++) {
4619         PetscInt j;
4620         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4621       }
4622       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4623       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4624       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4625     }
4626 
4627     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4628     if (n_vertices) {
4629       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4630       for (i=0;i<n_vertices;i++) {
4631         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4632         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4633         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4634         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4635         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4636         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4637       }
4638       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4639     }
4640     if (B_C) {
4641       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4642       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4643         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4644         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4645         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4646         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4647         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4648         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4649       }
4650       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4651     }
4652     /* coarse basis functions */
4653     for (i=0;i<pcbddc->local_primal_size;i++) {
4654       PetscScalar *y;
4655 
4656       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4657       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4658       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4659       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4660       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4661       if (i<n_vertices) {
4662         y[n_B*i+idx_V_B[i]] = 1.0;
4663       }
4664       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4665       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4666 
4667       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4668         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4669         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4670         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4671         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4672         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4673         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4674       }
4675       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4676     }
4677     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4678     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4679   }
4680 
4681   /* free memory */
4682   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4683   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4684   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4685   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4686   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4687   ierr = PetscFree(work);CHKERRQ(ierr);
4688   if (n_vertices) {
4689     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4690   }
4691   if (n_constraints) {
4692     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4693   }
4694   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4695 
4696   /* Checking coarse_sub_mat and coarse basis functios */
4697   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4698   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4699   if (pcbddc->dbg_flag) {
4700     Mat         coarse_sub_mat;
4701     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4702     Mat         coarse_phi_D,coarse_phi_B;
4703     Mat         coarse_psi_D,coarse_psi_B;
4704     Mat         A_II,A_BB,A_IB,A_BI;
4705     Mat         C_B,CPHI;
4706     IS          is_dummy;
4707     Vec         mones;
4708     MatType     checkmattype=MATSEQAIJ;
4709     PetscReal   real_value;
4710 
4711     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4712       Mat A;
4713       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4714       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4715       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4716       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4717       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4718       ierr = MatDestroy(&A);CHKERRQ(ierr);
4719     } else {
4720       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4721       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4722       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4723       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4724     }
4725     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4726     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4727     if (!pcbddc->symmetric_primal) {
4728       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4729       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4730     }
4731     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4732 
4733     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4734     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4735     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4736     if (!pcbddc->symmetric_primal) {
4737       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4738       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4739       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4740       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4741       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4742       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4743       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4744       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4745       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4746       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4747       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4748       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4749     } else {
4750       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4751       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4752       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4753       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4754       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4755       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4756       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4757       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4758     }
4759     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4760     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4761     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4762     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4763     if (pcbddc->benign_n) {
4764       Mat               B0_B,B0_BPHI;
4765       const PetscScalar *data2;
4766       PetscScalar       *data;
4767       PetscInt          j;
4768 
4769       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4770       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4771       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4772       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4773       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4774       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4775       for (j=0;j<pcbddc->benign_n;j++) {
4776         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4777         for (i=0;i<pcbddc->local_primal_size;i++) {
4778           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4779           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4780         }
4781       }
4782       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4783       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4784       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4785       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4786       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4787     }
4788 #if 0
4789   {
4790     PetscViewer viewer;
4791     char filename[256];
4792     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4793     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4794     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4795     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4796     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4797     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4798     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4799     if (pcbddc->coarse_phi_B) {
4800       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4801       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4802     }
4803     if (pcbddc->coarse_phi_D) {
4804       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4805       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4806     }
4807     if (pcbddc->coarse_psi_B) {
4808       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4809       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4810     }
4811     if (pcbddc->coarse_psi_D) {
4812       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4813       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4814     }
4815     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4816     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4817     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4818     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4819     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4820     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4821     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4822     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4823     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4824     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4825     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4826   }
4827 #endif
4828     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4829     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4830     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4831     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4832 
4833     /* check constraints */
4834     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4835     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4836     if (!pcbddc->benign_n) { /* TODO: add benign case */
4837       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4838     } else {
4839       PetscScalar *data;
4840       Mat         tmat;
4841       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4842       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4843       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4844       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4845       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4846     }
4847     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4848     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4849     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4850     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4851     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4852     if (!pcbddc->symmetric_primal) {
4853       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4854       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4855       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4856       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4857       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4858     }
4859     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4860     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4861     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4862     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4863     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4864     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4865     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4866     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4867     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4868     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4869     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4870     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4871     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4872     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4873     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4874     if (!pcbddc->symmetric_primal) {
4875       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4876       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4877     }
4878     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4879   }
4880   /* get back data */
4881   *coarse_submat_vals_n = coarse_submat_vals;
4882   PetscFunctionReturn(0);
4883 }
4884 
4885 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4886 {
4887   Mat            *work_mat;
4888   IS             isrow_s,iscol_s;
4889   PetscBool      rsorted,csorted;
4890   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4891   PetscErrorCode ierr;
4892 
4893   PetscFunctionBegin;
4894   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4895   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4896   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4897   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4898 
4899   if (!rsorted) {
4900     const PetscInt *idxs;
4901     PetscInt *idxs_sorted,i;
4902 
4903     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4904     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4905     for (i=0;i<rsize;i++) {
4906       idxs_perm_r[i] = i;
4907     }
4908     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4909     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4910     for (i=0;i<rsize;i++) {
4911       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4912     }
4913     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4914     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4915   } else {
4916     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4917     isrow_s = isrow;
4918   }
4919 
4920   if (!csorted) {
4921     if (isrow == iscol) {
4922       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4923       iscol_s = isrow_s;
4924     } else {
4925       const PetscInt *idxs;
4926       PetscInt       *idxs_sorted,i;
4927 
4928       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4929       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4930       for (i=0;i<csize;i++) {
4931         idxs_perm_c[i] = i;
4932       }
4933       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4934       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4935       for (i=0;i<csize;i++) {
4936         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4937       }
4938       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4939       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4940     }
4941   } else {
4942     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4943     iscol_s = iscol;
4944   }
4945 
4946   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4947 
4948   if (!rsorted || !csorted) {
4949     Mat      new_mat;
4950     IS       is_perm_r,is_perm_c;
4951 
4952     if (!rsorted) {
4953       PetscInt *idxs_r,i;
4954       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4955       for (i=0;i<rsize;i++) {
4956         idxs_r[idxs_perm_r[i]] = i;
4957       }
4958       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4959       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4960     } else {
4961       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4962     }
4963     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4964 
4965     if (!csorted) {
4966       if (isrow_s == iscol_s) {
4967         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4968         is_perm_c = is_perm_r;
4969       } else {
4970         PetscInt *idxs_c,i;
4971         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4972         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4973         for (i=0;i<csize;i++) {
4974           idxs_c[idxs_perm_c[i]] = i;
4975         }
4976         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4977         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4978       }
4979     } else {
4980       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4981     }
4982     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4983 
4984     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4985     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4986     work_mat[0] = new_mat;
4987     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4988     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4989   }
4990 
4991   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4992   *B = work_mat[0];
4993   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4994   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4995   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4996   PetscFunctionReturn(0);
4997 }
4998 
4999 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5000 {
5001   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5002   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5003   Mat            new_mat,lA;
5004   IS             is_local,is_global;
5005   PetscInt       local_size;
5006   PetscBool      isseqaij;
5007   PetscErrorCode ierr;
5008 
5009   PetscFunctionBegin;
5010   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5011   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5012   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5013   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5014   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5015   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5016   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5017 
5018   if (pcbddc->dbg_flag) {
5019     Vec       x,x_change;
5020     PetscReal error;
5021 
5022     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5023     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5024     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5025     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5026     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5027     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5028     if (!pcbddc->change_interior) {
5029       const PetscScalar *x,*y,*v;
5030       PetscReal         lerror = 0.;
5031       PetscInt          i;
5032 
5033       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5034       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5035       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5036       for (i=0;i<local_size;i++)
5037         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5038           lerror = PetscAbsScalar(x[i]-y[i]);
5039       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5040       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5041       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5042       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5043       if (error > PETSC_SMALL) {
5044         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5045           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5046         } else {
5047           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5048         }
5049       }
5050     }
5051     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5052     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5053     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5054     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5055     if (error > PETSC_SMALL) {
5056       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5057         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5058       } else {
5059         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5060       }
5061     }
5062     ierr = VecDestroy(&x);CHKERRQ(ierr);
5063     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5064   }
5065 
5066   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5067   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5068 
5069   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5070   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5071   if (isseqaij) {
5072     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5073     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5074     if (lA) {
5075       Mat work;
5076       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5077       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5078       ierr = MatDestroy(&work);CHKERRQ(ierr);
5079     }
5080   } else {
5081     Mat work_mat;
5082 
5083     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5084     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5085     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5086     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5087     if (lA) {
5088       Mat work;
5089       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5090       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5091       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5092       ierr = MatDestroy(&work);CHKERRQ(ierr);
5093     }
5094   }
5095   if (matis->A->symmetric_set) {
5096     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5097 #if !defined(PETSC_USE_COMPLEX)
5098     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5099 #endif
5100   }
5101   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5102   PetscFunctionReturn(0);
5103 }
5104 
5105 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5106 {
5107   PC_IS*          pcis = (PC_IS*)(pc->data);
5108   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5109   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5110   PetscInt        *idx_R_local=NULL;
5111   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5112   PetscInt        vbs,bs;
5113   PetscBT         bitmask=NULL;
5114   PetscErrorCode  ierr;
5115 
5116   PetscFunctionBegin;
5117   /*
5118     No need to setup local scatters if
5119       - primal space is unchanged
5120         AND
5121       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5122         AND
5123       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5124   */
5125   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5126     PetscFunctionReturn(0);
5127   }
5128   /* destroy old objects */
5129   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5130   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5131   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5132   /* Set Non-overlapping dimensions */
5133   n_B = pcis->n_B;
5134   n_D = pcis->n - n_B;
5135   n_vertices = pcbddc->n_vertices;
5136 
5137   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5138 
5139   /* create auxiliary bitmask and allocate workspace */
5140   if (!sub_schurs || !sub_schurs->reuse_solver) {
5141     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5142     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5143     for (i=0;i<n_vertices;i++) {
5144       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5145     }
5146 
5147     for (i=0, n_R=0; i<pcis->n; i++) {
5148       if (!PetscBTLookup(bitmask,i)) {
5149         idx_R_local[n_R++] = i;
5150       }
5151     }
5152   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5153     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5154 
5155     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5156     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5157   }
5158 
5159   /* Block code */
5160   vbs = 1;
5161   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5162   if (bs>1 && !(n_vertices%bs)) {
5163     PetscBool is_blocked = PETSC_TRUE;
5164     PetscInt  *vary;
5165     if (!sub_schurs || !sub_schurs->reuse_solver) {
5166       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5167       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5168       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5169       /* 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 */
5170       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5171       for (i=0; i<pcis->n/bs; i++) {
5172         if (vary[i]!=0 && vary[i]!=bs) {
5173           is_blocked = PETSC_FALSE;
5174           break;
5175         }
5176       }
5177       ierr = PetscFree(vary);CHKERRQ(ierr);
5178     } else {
5179       /* Verify directly the R set */
5180       for (i=0; i<n_R/bs; i++) {
5181         PetscInt j,node=idx_R_local[bs*i];
5182         for (j=1; j<bs; j++) {
5183           if (node != idx_R_local[bs*i+j]-j) {
5184             is_blocked = PETSC_FALSE;
5185             break;
5186           }
5187         }
5188       }
5189     }
5190     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5191       vbs = bs;
5192       for (i=0;i<n_R/vbs;i++) {
5193         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5194       }
5195     }
5196   }
5197   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5198   if (sub_schurs && sub_schurs->reuse_solver) {
5199     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5200 
5201     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5202     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5203     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5204     reuse_solver->is_R = pcbddc->is_R_local;
5205   } else {
5206     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5207   }
5208 
5209   /* print some info if requested */
5210   if (pcbddc->dbg_flag) {
5211     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5212     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5213     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5214     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5215     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5216     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);
5217     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218   }
5219 
5220   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5221   if (!sub_schurs || !sub_schurs->reuse_solver) {
5222     IS       is_aux1,is_aux2;
5223     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5224 
5225     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5226     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5227     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5228     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5229     for (i=0; i<n_D; i++) {
5230       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5231     }
5232     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5233     for (i=0, j=0; i<n_R; i++) {
5234       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5235         aux_array1[j++] = i;
5236       }
5237     }
5238     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5239     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5240     for (i=0, j=0; i<n_B; i++) {
5241       if (!PetscBTLookup(bitmask,is_indices[i])) {
5242         aux_array2[j++] = i;
5243       }
5244     }
5245     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5246     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5247     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5248     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5249     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5250 
5251     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5252       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5253       for (i=0, j=0; i<n_R; i++) {
5254         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5255           aux_array1[j++] = i;
5256         }
5257       }
5258       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5259       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5260       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5261     }
5262     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5263     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5264   } else {
5265     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5266     IS                 tis;
5267     PetscInt           schur_size;
5268 
5269     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5270     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5271     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5272     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5273     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5274       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5275       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5276       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5277     }
5278   }
5279   PetscFunctionReturn(0);
5280 }
5281 
5282 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5283 {
5284   MatNullSpace   NullSpace;
5285   Mat            dmat;
5286   const Vec      *nullvecs;
5287   Vec            v,v2,*nullvecs2;
5288   VecScatter     sct = NULL;
5289   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5290   PetscBool      nnsp_has_cnst;
5291   PetscErrorCode ierr;
5292 
5293   PetscFunctionBegin;
5294   if (!is && !B) { /* MATIS */
5295     Mat_IS* matis = (Mat_IS*)A->data;
5296 
5297     if (!B) {
5298       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5299     }
5300     sct  = matis->cctx;
5301     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5302   } else {
5303     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5304     if (!NullSpace) {
5305       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5306     }
5307     if (NullSpace) PetscFunctionReturn(0);
5308   }
5309   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5310   if (!NullSpace) {
5311     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5312   }
5313   if (!NullSpace) PetscFunctionReturn(0);
5314 
5315   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5316   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5317   if (!sct) {
5318     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5319   }
5320   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5321   bsiz = nnsp_size+!!nnsp_has_cnst;
5322   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5323   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5324   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5325   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5326   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5327   for (k=0;k<nnsp_size;k++) {
5328     PetscScalar *arr;
5329 
5330     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5331     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5332     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5333     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5334     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5335   }
5336   if (nnsp_has_cnst) {
5337     PetscScalar *arr;
5338 
5339     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5340     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5341     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5342     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5343   }
5344   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5345   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5346   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5347   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5348   for (k=0;k<bsiz;k++) {
5349     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5350   }
5351   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5352   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5353   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5354   ierr = VecDestroy(&v);CHKERRQ(ierr);
5355   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5356   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5357   PetscFunctionReturn(0);
5358 }
5359 
5360 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5361 {
5362   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5363   PC_IS          *pcis = (PC_IS*)pc->data;
5364   PC             pc_temp;
5365   Mat            A_RR;
5366   MatNullSpace   nnsp;
5367   MatReuse       reuse;
5368   PetscScalar    m_one = -1.0;
5369   PetscReal      value;
5370   PetscInt       n_D,n_R;
5371   PetscBool      issbaij,opts;
5372   PetscErrorCode ierr;
5373   void           (*f)(void) = 0;
5374   char           dir_prefix[256],neu_prefix[256],str_level[16];
5375   size_t         len;
5376 
5377   PetscFunctionBegin;
5378   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5379   /* approximate solver, propagate NearNullSpace if needed */
5380   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5381     MatNullSpace gnnsp1,gnnsp2;
5382     PetscBool    lhas,ghas;
5383 
5384     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5385     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5386     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5387     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5388     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5389     if (!ghas && (gnnsp1 || gnnsp2)) {
5390       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5391     }
5392   }
5393 
5394   /* compute prefixes */
5395   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5396   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5397   if (!pcbddc->current_level) {
5398     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5399     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5400     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5401     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5402   } else {
5403     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5404     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5405     len -= 15; /* remove "pc_bddc_coarse_" */
5406     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5407     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5408     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5409     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5410     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5411     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5412     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5413     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5414     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5415   }
5416 
5417   /* DIRICHLET PROBLEM */
5418   if (dirichlet) {
5419     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5420     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5421       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5422       if (pcbddc->dbg_flag) {
5423         Mat    A_IIn;
5424 
5425         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5426         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5427         pcis->A_II = A_IIn;
5428       }
5429     }
5430     if (pcbddc->local_mat->symmetric_set) {
5431       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5432     }
5433     /* Matrix for Dirichlet problem is pcis->A_II */
5434     n_D  = pcis->n - pcis->n_B;
5435     opts = PETSC_FALSE;
5436     if (!pcbddc->ksp_D) { /* create object if not yet build */
5437       opts = PETSC_TRUE;
5438       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5439       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5440       /* default */
5441       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5442       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5443       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5444       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5445       if (issbaij) {
5446         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5447       } else {
5448         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5449       }
5450       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5451     }
5452     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5453     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5454     /* Allow user's customization */
5455     if (opts) {
5456       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5457     }
5458     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5459     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5460       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5461     }
5462     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5463     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5464     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5465     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5466       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5467       const PetscInt *idxs;
5468       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5469 
5470       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5471       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5472       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5473       for (i=0;i<nl;i++) {
5474         for (d=0;d<cdim;d++) {
5475           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5476         }
5477       }
5478       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5479       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5480       ierr = PetscFree(scoords);CHKERRQ(ierr);
5481     }
5482     if (sub_schurs && sub_schurs->reuse_solver) {
5483       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5484 
5485       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5486     }
5487 
5488     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5489     if (!n_D) {
5490       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5491       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5492     }
5493     /* set ksp_D into pcis data */
5494     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5495     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5496     pcis->ksp_D = pcbddc->ksp_D;
5497   }
5498 
5499   /* NEUMANN PROBLEM */
5500   A_RR = 0;
5501   if (neumann) {
5502     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5503     PetscInt        ibs,mbs;
5504     PetscBool       issbaij, reuse_neumann_solver;
5505     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5506 
5507     reuse_neumann_solver = PETSC_FALSE;
5508     if (sub_schurs && sub_schurs->reuse_solver) {
5509       IS iP;
5510 
5511       reuse_neumann_solver = PETSC_TRUE;
5512       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5513       if (iP) reuse_neumann_solver = PETSC_FALSE;
5514     }
5515     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5516     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5517     if (pcbddc->ksp_R) { /* already created ksp */
5518       PetscInt nn_R;
5519       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5520       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5521       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5522       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5523         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5524         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5525         reuse = MAT_INITIAL_MATRIX;
5526       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5527         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5528           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5529           reuse = MAT_INITIAL_MATRIX;
5530         } else { /* safe to reuse the matrix */
5531           reuse = MAT_REUSE_MATRIX;
5532         }
5533       }
5534       /* last check */
5535       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5536         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5537         reuse = MAT_INITIAL_MATRIX;
5538       }
5539     } else { /* first time, so we need to create the matrix */
5540       reuse = MAT_INITIAL_MATRIX;
5541     }
5542     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5543     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5544     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5545     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5546     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5547       if (matis->A == pcbddc->local_mat) {
5548         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5549         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5550       } else {
5551         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5552       }
5553     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5554       if (matis->A == pcbddc->local_mat) {
5555         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5556         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5557       } else {
5558         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5559       }
5560     }
5561     /* extract A_RR */
5562     if (reuse_neumann_solver) {
5563       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5564 
5565       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5566         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5567         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5568           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5569         } else {
5570           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5571         }
5572       } else {
5573         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5574         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5575         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5576       }
5577     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5578       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5579     }
5580     if (pcbddc->local_mat->symmetric_set) {
5581       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5582     }
5583     opts = PETSC_FALSE;
5584     if (!pcbddc->ksp_R) { /* create object if not present */
5585       opts = PETSC_TRUE;
5586       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5587       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5588       /* default */
5589       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5590       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5591       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5592       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5593       if (issbaij) {
5594         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5595       } else {
5596         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5597       }
5598       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5599     }
5600     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5601     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5602     if (opts) { /* Allow user's customization once */
5603       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5604     }
5605     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5606     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5607       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5608     }
5609     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5610     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5611     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5612     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5613       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5614       const PetscInt *idxs;
5615       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5616 
5617       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5618       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5619       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5620       for (i=0;i<nl;i++) {
5621         for (d=0;d<cdim;d++) {
5622           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5623         }
5624       }
5625       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5626       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5627       ierr = PetscFree(scoords);CHKERRQ(ierr);
5628     }
5629 
5630     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5631     if (!n_R) {
5632       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5633       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5634     }
5635     /* Reuse solver if it is present */
5636     if (reuse_neumann_solver) {
5637       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5638 
5639       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5640     }
5641   }
5642 
5643   if (pcbddc->dbg_flag) {
5644     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5645     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5646     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5647   }
5648   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5649 
5650   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5651   if (pcbddc->NullSpace_corr[0]) {
5652     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5653   }
5654   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5655     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5656   }
5657   if (neumann && pcbddc->NullSpace_corr[2]) {
5658     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5659   }
5660   /* check Dirichlet and Neumann solvers */
5661   if (pcbddc->dbg_flag) {
5662     if (dirichlet) { /* Dirichlet */
5663       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5664       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5665       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5666       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5667       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5668       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5669       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);
5670       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5671     }
5672     if (neumann) { /* Neumann */
5673       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5674       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5675       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5676       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5677       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5678       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5679       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);
5680       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5681     }
5682   }
5683   /* free Neumann problem's matrix */
5684   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5685   PetscFunctionReturn(0);
5686 }
5687 
5688 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5689 {
5690   PetscErrorCode  ierr;
5691   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5692   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5693   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5694 
5695   PetscFunctionBegin;
5696   if (!reuse_solver) {
5697     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5698   }
5699   if (!pcbddc->switch_static) {
5700     if (applytranspose && pcbddc->local_auxmat1) {
5701       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5702       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5703     }
5704     if (!reuse_solver) {
5705       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5706       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5707     } else {
5708       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5709 
5710       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5711       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5712     }
5713   } else {
5714     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5715     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5716     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5717     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5718     if (applytranspose && pcbddc->local_auxmat1) {
5719       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5720       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5721       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5722       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5723     }
5724   }
5725   if (!reuse_solver || pcbddc->switch_static) {
5726     if (applytranspose) {
5727       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5728     } else {
5729       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5730     }
5731     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5732   } else {
5733     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5734 
5735     if (applytranspose) {
5736       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5737     } else {
5738       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5739     }
5740   }
5741   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5742   if (!pcbddc->switch_static) {
5743     if (!reuse_solver) {
5744       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5745       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5746     } else {
5747       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5748 
5749       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5750       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5751     }
5752     if (!applytranspose && pcbddc->local_auxmat1) {
5753       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5754       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5755     }
5756   } else {
5757     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5758     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5759     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5760     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5761     if (!applytranspose && pcbddc->local_auxmat1) {
5762       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5763       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5764     }
5765     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5766     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5767     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5768     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5769   }
5770   PetscFunctionReturn(0);
5771 }
5772 
5773 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5774 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5775 {
5776   PetscErrorCode ierr;
5777   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5778   PC_IS*            pcis = (PC_IS*)  (pc->data);
5779   const PetscScalar zero = 0.0;
5780 
5781   PetscFunctionBegin;
5782   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5783   if (!pcbddc->benign_apply_coarse_only) {
5784     if (applytranspose) {
5785       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5786       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5787     } else {
5788       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5789       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5790     }
5791   } else {
5792     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5793   }
5794 
5795   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5796   if (pcbddc->benign_n) {
5797     PetscScalar *array;
5798     PetscInt    j;
5799 
5800     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5801     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5802     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5803   }
5804 
5805   /* start communications from local primal nodes to rhs of coarse solver */
5806   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5807   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5808   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5809 
5810   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5811   if (pcbddc->coarse_ksp) {
5812     Mat          coarse_mat;
5813     Vec          rhs,sol;
5814     MatNullSpace nullsp;
5815     PetscBool    isbddc = PETSC_FALSE;
5816 
5817     if (pcbddc->benign_have_null) {
5818       PC        coarse_pc;
5819 
5820       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5821       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5822       /* we need to propagate to coarser levels the need for a possible benign correction */
5823       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5824         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5825         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5826         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5827       }
5828     }
5829     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5830     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5831     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5832     if (applytranspose) {
5833       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5834       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5835       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5836       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5837       if (nullsp) {
5838         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5839       }
5840     } else {
5841       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5842       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5843         PC        coarse_pc;
5844 
5845         if (nullsp) {
5846           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5847         }
5848         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5849         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5850         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5851         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5852       } else {
5853         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5854         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5855         if (nullsp) {
5856           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5857         }
5858       }
5859     }
5860     /* we don't need the benign correction at coarser levels anymore */
5861     if (pcbddc->benign_have_null && isbddc) {
5862       PC        coarse_pc;
5863       PC_BDDC*  coarsepcbddc;
5864 
5865       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5866       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5867       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5868       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5869     }
5870   }
5871 
5872   /* Local solution on R nodes */
5873   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5874     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5875   }
5876   /* communications from coarse sol to local primal nodes */
5877   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5878   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5879 
5880   /* Sum contributions from the two levels */
5881   if (!pcbddc->benign_apply_coarse_only) {
5882     if (applytranspose) {
5883       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5884       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5885     } else {
5886       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5887       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5888     }
5889     /* store p0 */
5890     if (pcbddc->benign_n) {
5891       PetscScalar *array;
5892       PetscInt    j;
5893 
5894       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5895       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5896       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5897     }
5898   } else { /* expand the coarse solution */
5899     if (applytranspose) {
5900       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5901     } else {
5902       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5903     }
5904   }
5905   PetscFunctionReturn(0);
5906 }
5907 
5908 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5909 {
5910   PetscErrorCode ierr;
5911   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5912   PetscScalar    *array;
5913   Vec            from,to;
5914 
5915   PetscFunctionBegin;
5916   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5917     from = pcbddc->coarse_vec;
5918     to = pcbddc->vec1_P;
5919     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5920       Vec tvec;
5921 
5922       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5923       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5924       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5925       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5926       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5927       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5928     }
5929   } else { /* from local to global -> put data in coarse right hand side */
5930     from = pcbddc->vec1_P;
5931     to = pcbddc->coarse_vec;
5932   }
5933   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5934   PetscFunctionReturn(0);
5935 }
5936 
5937 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5938 {
5939   PetscErrorCode ierr;
5940   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5941   PetscScalar    *array;
5942   Vec            from,to;
5943 
5944   PetscFunctionBegin;
5945   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5946     from = pcbddc->coarse_vec;
5947     to = pcbddc->vec1_P;
5948   } else { /* from local to global -> put data in coarse right hand side */
5949     from = pcbddc->vec1_P;
5950     to = pcbddc->coarse_vec;
5951   }
5952   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5953   if (smode == SCATTER_FORWARD) {
5954     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5955       Vec tvec;
5956 
5957       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5958       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5959       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5960       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5961     }
5962   } else {
5963     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5964      ierr = VecResetArray(from);CHKERRQ(ierr);
5965     }
5966   }
5967   PetscFunctionReturn(0);
5968 }
5969 
5970 /* uncomment for testing purposes */
5971 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5972 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5973 {
5974   PetscErrorCode    ierr;
5975   PC_IS*            pcis = (PC_IS*)(pc->data);
5976   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5977   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5978   /* one and zero */
5979   PetscScalar       one=1.0,zero=0.0;
5980   /* space to store constraints and their local indices */
5981   PetscScalar       *constraints_data;
5982   PetscInt          *constraints_idxs,*constraints_idxs_B;
5983   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5984   PetscInt          *constraints_n;
5985   /* iterators */
5986   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5987   /* BLAS integers */
5988   PetscBLASInt      lwork,lierr;
5989   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5990   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5991   /* reuse */
5992   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5993   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5994   /* change of basis */
5995   PetscBool         qr_needed;
5996   PetscBT           change_basis,qr_needed_idx;
5997   /* auxiliary stuff */
5998   PetscInt          *nnz,*is_indices;
5999   PetscInt          ncc;
6000   /* some quantities */
6001   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6002   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6003   PetscReal         tol; /* tolerance for retaining eigenmodes */
6004 
6005   PetscFunctionBegin;
6006   tol  = PetscSqrtReal(PETSC_SMALL);
6007   /* Destroy Mat objects computed previously */
6008   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6009   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6010   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6011   /* save info on constraints from previous setup (if any) */
6012   olocal_primal_size = pcbddc->local_primal_size;
6013   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6014   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6015   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6016   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6017   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6018   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6019 
6020   if (!pcbddc->adaptive_selection) {
6021     IS           ISForVertices,*ISForFaces,*ISForEdges;
6022     MatNullSpace nearnullsp;
6023     const Vec    *nearnullvecs;
6024     Vec          *localnearnullsp;
6025     PetscScalar  *array;
6026     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6027     PetscBool    nnsp_has_cnst;
6028     /* LAPACK working arrays for SVD or POD */
6029     PetscBool    skip_lapack,boolforchange;
6030     PetscScalar  *work;
6031     PetscReal    *singular_vals;
6032 #if defined(PETSC_USE_COMPLEX)
6033     PetscReal    *rwork;
6034 #endif
6035 #if defined(PETSC_MISSING_LAPACK_GESVD)
6036     PetscScalar  *temp_basis,*correlation_mat;
6037 #else
6038     PetscBLASInt dummy_int=1;
6039     PetscScalar  dummy_scalar=1.;
6040 #endif
6041 
6042     /* Get index sets for faces, edges and vertices from graph */
6043     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6044     /* print some info */
6045     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6046       PetscInt nv;
6047 
6048       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6049       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6050       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6051       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6052       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6053       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6054       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6055       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6056       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6057     }
6058 
6059     /* free unneeded index sets */
6060     if (!pcbddc->use_vertices) {
6061       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6062     }
6063     if (!pcbddc->use_edges) {
6064       for (i=0;i<n_ISForEdges;i++) {
6065         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6066       }
6067       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6068       n_ISForEdges = 0;
6069     }
6070     if (!pcbddc->use_faces) {
6071       for (i=0;i<n_ISForFaces;i++) {
6072         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6073       }
6074       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6075       n_ISForFaces = 0;
6076     }
6077 
6078     /* check if near null space is attached to global mat */
6079     if (pcbddc->use_nnsp) {
6080       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6081     } else nearnullsp = NULL;
6082 
6083     if (nearnullsp) {
6084       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6085       /* remove any stored info */
6086       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6087       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6088       /* store information for BDDC solver reuse */
6089       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6090       pcbddc->onearnullspace = nearnullsp;
6091       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6092       for (i=0;i<nnsp_size;i++) {
6093         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6094       }
6095     } else { /* if near null space is not provided BDDC uses constants by default */
6096       nnsp_size = 0;
6097       nnsp_has_cnst = PETSC_TRUE;
6098     }
6099     /* get max number of constraints on a single cc */
6100     max_constraints = nnsp_size;
6101     if (nnsp_has_cnst) max_constraints++;
6102 
6103     /*
6104          Evaluate maximum storage size needed by the procedure
6105          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6106          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6107          There can be multiple constraints per connected component
6108                                                                                                                                                            */
6109     n_vertices = 0;
6110     if (ISForVertices) {
6111       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6112     }
6113     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6114     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6115 
6116     total_counts = n_ISForFaces+n_ISForEdges;
6117     total_counts *= max_constraints;
6118     total_counts += n_vertices;
6119     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6120 
6121     total_counts = 0;
6122     max_size_of_constraint = 0;
6123     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6124       IS used_is;
6125       if (i<n_ISForEdges) {
6126         used_is = ISForEdges[i];
6127       } else {
6128         used_is = ISForFaces[i-n_ISForEdges];
6129       }
6130       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6131       total_counts += j;
6132       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6133     }
6134     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);
6135 
6136     /* get local part of global near null space vectors */
6137     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6138     for (k=0;k<nnsp_size;k++) {
6139       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6140       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6141       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6142     }
6143 
6144     /* whether or not to skip lapack calls */
6145     skip_lapack = PETSC_TRUE;
6146     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6147 
6148     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6149     if (!skip_lapack) {
6150       PetscScalar temp_work;
6151 
6152 #if defined(PETSC_MISSING_LAPACK_GESVD)
6153       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6154       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6155       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6156       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6157 #if defined(PETSC_USE_COMPLEX)
6158       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6159 #endif
6160       /* now we evaluate the optimal workspace using query with lwork=-1 */
6161       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6162       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6163       lwork = -1;
6164       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6165 #if !defined(PETSC_USE_COMPLEX)
6166       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6167 #else
6168       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6169 #endif
6170       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6171       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6172 #else /* on missing GESVD */
6173       /* SVD */
6174       PetscInt max_n,min_n;
6175       max_n = max_size_of_constraint;
6176       min_n = max_constraints;
6177       if (max_size_of_constraint < max_constraints) {
6178         min_n = max_size_of_constraint;
6179         max_n = max_constraints;
6180       }
6181       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6182 #if defined(PETSC_USE_COMPLEX)
6183       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6184 #endif
6185       /* now we evaluate the optimal workspace using query with lwork=-1 */
6186       lwork = -1;
6187       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6188       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6189       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6190       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6191 #if !defined(PETSC_USE_COMPLEX)
6192       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));
6193 #else
6194       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));
6195 #endif
6196       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6197       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6198 #endif /* on missing GESVD */
6199       /* Allocate optimal workspace */
6200       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6201       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6202     }
6203     /* Now we can loop on constraining sets */
6204     total_counts = 0;
6205     constraints_idxs_ptr[0] = 0;
6206     constraints_data_ptr[0] = 0;
6207     /* vertices */
6208     if (n_vertices) {
6209       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6210       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6211       for (i=0;i<n_vertices;i++) {
6212         constraints_n[total_counts] = 1;
6213         constraints_data[total_counts] = 1.0;
6214         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6215         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6216         total_counts++;
6217       }
6218       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6219       n_vertices = total_counts;
6220     }
6221 
6222     /* edges and faces */
6223     total_counts_cc = total_counts;
6224     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6225       IS        used_is;
6226       PetscBool idxs_copied = PETSC_FALSE;
6227 
6228       if (ncc<n_ISForEdges) {
6229         used_is = ISForEdges[ncc];
6230         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6231       } else {
6232         used_is = ISForFaces[ncc-n_ISForEdges];
6233         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6234       }
6235       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6236 
6237       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6238       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6239       /* change of basis should not be performed on local periodic nodes */
6240       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6241       if (nnsp_has_cnst) {
6242         PetscScalar quad_value;
6243 
6244         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6245         idxs_copied = PETSC_TRUE;
6246 
6247         if (!pcbddc->use_nnsp_true) {
6248           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6249         } else {
6250           quad_value = 1.0;
6251         }
6252         for (j=0;j<size_of_constraint;j++) {
6253           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6254         }
6255         temp_constraints++;
6256         total_counts++;
6257       }
6258       for (k=0;k<nnsp_size;k++) {
6259         PetscReal real_value;
6260         PetscScalar *ptr_to_data;
6261 
6262         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6263         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6264         for (j=0;j<size_of_constraint;j++) {
6265           ptr_to_data[j] = array[is_indices[j]];
6266         }
6267         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6268         /* check if array is null on the connected component */
6269         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6270         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6271         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6272           temp_constraints++;
6273           total_counts++;
6274           if (!idxs_copied) {
6275             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6276             idxs_copied = PETSC_TRUE;
6277           }
6278         }
6279       }
6280       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6281       valid_constraints = temp_constraints;
6282       if (!pcbddc->use_nnsp_true && temp_constraints) {
6283         if (temp_constraints == 1) { /* just normalize the constraint */
6284           PetscScalar norm,*ptr_to_data;
6285 
6286           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6287           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6288           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6289           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6290           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6291         } else { /* perform SVD */
6292           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6293 
6294 #if defined(PETSC_MISSING_LAPACK_GESVD)
6295           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6296              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6297              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6298                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6299                 from that computed using LAPACKgesvd
6300              -> This is due to a different computation of eigenvectors in LAPACKheev
6301              -> The quality of the POD-computed basis will be the same */
6302           ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6303           /* Store upper triangular part of correlation matrix */
6304           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6305           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6306           for (j=0;j<temp_constraints;j++) {
6307             for (k=0;k<j+1;k++) {
6308               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));
6309             }
6310           }
6311           /* compute eigenvalues and eigenvectors of correlation matrix */
6312           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6313           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6314 #if !defined(PETSC_USE_COMPLEX)
6315           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6316 #else
6317           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6318 #endif
6319           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6320           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6321           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6322           j = 0;
6323           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6324           total_counts = total_counts-j;
6325           valid_constraints = temp_constraints-j;
6326           /* scale and copy POD basis into used quadrature memory */
6327           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6328           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6329           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6330           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6331           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6332           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6333           if (j<temp_constraints) {
6334             PetscInt ii;
6335             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6336             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6337             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));
6338             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6339             for (k=0;k<temp_constraints-j;k++) {
6340               for (ii=0;ii<size_of_constraint;ii++) {
6341                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6342               }
6343             }
6344           }
6345 #else  /* on missing GESVD */
6346           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6347           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6348           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6349           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6350 #if !defined(PETSC_USE_COMPLEX)
6351           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));
6352 #else
6353           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));
6354 #endif
6355           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6356           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6357           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6358           k = temp_constraints;
6359           if (k > size_of_constraint) k = size_of_constraint;
6360           j = 0;
6361           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6362           valid_constraints = k-j;
6363           total_counts = total_counts-temp_constraints+valid_constraints;
6364 #endif /* on missing GESVD */
6365         }
6366       }
6367       /* update pointers information */
6368       if (valid_constraints) {
6369         constraints_n[total_counts_cc] = valid_constraints;
6370         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6371         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6372         /* set change_of_basis flag */
6373         if (boolforchange) {
6374           PetscBTSet(change_basis,total_counts_cc);
6375         }
6376         total_counts_cc++;
6377       }
6378     }
6379     /* free workspace */
6380     if (!skip_lapack) {
6381       ierr = PetscFree(work);CHKERRQ(ierr);
6382 #if defined(PETSC_USE_COMPLEX)
6383       ierr = PetscFree(rwork);CHKERRQ(ierr);
6384 #endif
6385       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6386 #if defined(PETSC_MISSING_LAPACK_GESVD)
6387       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6388       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6389 #endif
6390     }
6391     for (k=0;k<nnsp_size;k++) {
6392       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6393     }
6394     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6395     /* free index sets of faces, edges and vertices */
6396     for (i=0;i<n_ISForFaces;i++) {
6397       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6398     }
6399     if (n_ISForFaces) {
6400       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6401     }
6402     for (i=0;i<n_ISForEdges;i++) {
6403       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6404     }
6405     if (n_ISForEdges) {
6406       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6407     }
6408     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6409   } else {
6410     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6411 
6412     total_counts = 0;
6413     n_vertices = 0;
6414     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6415       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6416     }
6417     max_constraints = 0;
6418     total_counts_cc = 0;
6419     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6420       total_counts += pcbddc->adaptive_constraints_n[i];
6421       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6422       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6423     }
6424     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6425     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6426     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6427     constraints_data = pcbddc->adaptive_constraints_data;
6428     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6429     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6430     total_counts_cc = 0;
6431     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6432       if (pcbddc->adaptive_constraints_n[i]) {
6433         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6434       }
6435     }
6436 
6437     max_size_of_constraint = 0;
6438     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]);
6439     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6440     /* Change of basis */
6441     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6442     if (pcbddc->use_change_of_basis) {
6443       for (i=0;i<sub_schurs->n_subs;i++) {
6444         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6445           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6446         }
6447       }
6448     }
6449   }
6450   pcbddc->local_primal_size = total_counts;
6451   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6452 
6453   /* map constraints_idxs in boundary numbering */
6454   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6455   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i);
6456 
6457   /* Create constraint matrix */
6458   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6459   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6460   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6461 
6462   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6463   /* determine if a QR strategy is needed for change of basis */
6464   qr_needed = pcbddc->use_qr_single;
6465   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6466   total_primal_vertices=0;
6467   pcbddc->local_primal_size_cc = 0;
6468   for (i=0;i<total_counts_cc;i++) {
6469     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6470     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6471       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6472       pcbddc->local_primal_size_cc += 1;
6473     } else if (PetscBTLookup(change_basis,i)) {
6474       for (k=0;k<constraints_n[i];k++) {
6475         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6476       }
6477       pcbddc->local_primal_size_cc += constraints_n[i];
6478       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6479         PetscBTSet(qr_needed_idx,i);
6480         qr_needed = PETSC_TRUE;
6481       }
6482     } else {
6483       pcbddc->local_primal_size_cc += 1;
6484     }
6485   }
6486   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6487   pcbddc->n_vertices = total_primal_vertices;
6488   /* permute indices in order to have a sorted set of vertices */
6489   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6490   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);
6491   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6492   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6493 
6494   /* nonzero structure of constraint matrix */
6495   /* and get reference dof for local constraints */
6496   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6497   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6498 
6499   j = total_primal_vertices;
6500   total_counts = total_primal_vertices;
6501   cum = total_primal_vertices;
6502   for (i=n_vertices;i<total_counts_cc;i++) {
6503     if (!PetscBTLookup(change_basis,i)) {
6504       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6505       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6506       cum++;
6507       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6508       for (k=0;k<constraints_n[i];k++) {
6509         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6510         nnz[j+k] = size_of_constraint;
6511       }
6512       j += constraints_n[i];
6513     }
6514   }
6515   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6516   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6517   ierr = PetscFree(nnz);CHKERRQ(ierr);
6518 
6519   /* set values in constraint matrix */
6520   for (i=0;i<total_primal_vertices;i++) {
6521     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6522   }
6523   total_counts = total_primal_vertices;
6524   for (i=n_vertices;i<total_counts_cc;i++) {
6525     if (!PetscBTLookup(change_basis,i)) {
6526       PetscInt *cols;
6527 
6528       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6529       cols = constraints_idxs+constraints_idxs_ptr[i];
6530       for (k=0;k<constraints_n[i];k++) {
6531         PetscInt    row = total_counts+k;
6532         PetscScalar *vals;
6533 
6534         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6535         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6536       }
6537       total_counts += constraints_n[i];
6538     }
6539   }
6540   /* assembling */
6541   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6542   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6543   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6544 
6545   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6546   if (pcbddc->use_change_of_basis) {
6547     /* dual and primal dofs on a single cc */
6548     PetscInt     dual_dofs,primal_dofs;
6549     /* working stuff for GEQRF */
6550     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6551     PetscBLASInt lqr_work;
6552     /* working stuff for UNGQR */
6553     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6554     PetscBLASInt lgqr_work;
6555     /* working stuff for TRTRS */
6556     PetscScalar  *trs_rhs = NULL;
6557     PetscBLASInt Blas_NRHS;
6558     /* pointers for values insertion into change of basis matrix */
6559     PetscInt     *start_rows,*start_cols;
6560     PetscScalar  *start_vals;
6561     /* working stuff for values insertion */
6562     PetscBT      is_primal;
6563     PetscInt     *aux_primal_numbering_B;
6564     /* matrix sizes */
6565     PetscInt     global_size,local_size;
6566     /* temporary change of basis */
6567     Mat          localChangeOfBasisMatrix;
6568     /* extra space for debugging */
6569     PetscScalar  *dbg_work = NULL;
6570 
6571     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6572     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6573     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6574     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6575     /* nonzeros for local mat */
6576     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6577     if (!pcbddc->benign_change || pcbddc->fake_change) {
6578       for (i=0;i<pcis->n;i++) nnz[i]=1;
6579     } else {
6580       const PetscInt *ii;
6581       PetscInt       n;
6582       PetscBool      flg_row;
6583       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6584       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6585       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6586     }
6587     for (i=n_vertices;i<total_counts_cc;i++) {
6588       if (PetscBTLookup(change_basis,i)) {
6589         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6590         if (PetscBTLookup(qr_needed_idx,i)) {
6591           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6592         } else {
6593           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6594           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6595         }
6596       }
6597     }
6598     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6599     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6600     ierr = PetscFree(nnz);CHKERRQ(ierr);
6601     /* Set interior change in the matrix */
6602     if (!pcbddc->benign_change || pcbddc->fake_change) {
6603       for (i=0;i<pcis->n;i++) {
6604         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6605       }
6606     } else {
6607       const PetscInt *ii,*jj;
6608       PetscScalar    *aa;
6609       PetscInt       n;
6610       PetscBool      flg_row;
6611       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6612       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6613       for (i=0;i<n;i++) {
6614         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6615       }
6616       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6617       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6618     }
6619 
6620     if (pcbddc->dbg_flag) {
6621       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6622       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6623     }
6624 
6625 
6626     /* Now we loop on the constraints which need a change of basis */
6627     /*
6628        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6629        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6630 
6631        Basic blocks of change of basis matrix T computed by
6632 
6633           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6634 
6635             | 1        0   ...        0         s_1/S |
6636             | 0        1   ...        0         s_2/S |
6637             |              ...                        |
6638             | 0        ...            1     s_{n-1}/S |
6639             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6640 
6641             with S = \sum_{i=1}^n s_i^2
6642             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6643                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6644 
6645           - QR decomposition of constraints otherwise
6646     */
6647     if (qr_needed && max_size_of_constraint) {
6648       /* space to store Q */
6649       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6650       /* array to store scaling factors for reflectors */
6651       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6652       /* first we issue queries for optimal work */
6653       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6654       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6655       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6656       lqr_work = -1;
6657       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6658       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6659       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6660       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6661       lgqr_work = -1;
6662       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6663       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6664       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6665       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6666       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6667       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6668       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6669       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6670       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6671       /* array to store rhs and solution of triangular solver */
6672       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6673       /* allocating workspace for check */
6674       if (pcbddc->dbg_flag) {
6675         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6676       }
6677     }
6678     /* array to store whether a node is primal or not */
6679     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6680     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6681     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6682     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i);
6683     for (i=0;i<total_primal_vertices;i++) {
6684       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6685     }
6686     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6687 
6688     /* loop on constraints and see whether or not they need a change of basis and compute it */
6689     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6690       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6691       if (PetscBTLookup(change_basis,total_counts)) {
6692         /* get constraint info */
6693         primal_dofs = constraints_n[total_counts];
6694         dual_dofs = size_of_constraint-primal_dofs;
6695 
6696         if (pcbddc->dbg_flag) {
6697           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);
6698         }
6699 
6700         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6701 
6702           /* copy quadrature constraints for change of basis check */
6703           if (pcbddc->dbg_flag) {
6704             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6705           }
6706           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6707           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6708 
6709           /* compute QR decomposition of constraints */
6710           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6711           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6712           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6713           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6714           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6715           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6716           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6717 
6718           /* explictly compute R^-T */
6719           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6720           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6721           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6722           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6723           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6724           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6725           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6726           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6727           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6728           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6729 
6730           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6731           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6732           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6733           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6734           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6735           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6736           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6737           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6738           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6739 
6740           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6741              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6742              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6743           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6744           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6745           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6746           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6747           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6748           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6749           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6750           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));
6751           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6752           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6753 
6754           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6755           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6756           /* insert cols for primal dofs */
6757           for (j=0;j<primal_dofs;j++) {
6758             start_vals = &qr_basis[j*size_of_constraint];
6759             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6760             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6761           }
6762           /* insert cols for dual dofs */
6763           for (j=0,k=0;j<dual_dofs;k++) {
6764             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6765               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6766               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6767               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6768               j++;
6769             }
6770           }
6771 
6772           /* check change of basis */
6773           if (pcbddc->dbg_flag) {
6774             PetscInt   ii,jj;
6775             PetscBool valid_qr=PETSC_TRUE;
6776             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6777             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6778             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6779             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6780             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6781             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6782             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6783             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));
6784             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6785             for (jj=0;jj<size_of_constraint;jj++) {
6786               for (ii=0;ii<primal_dofs;ii++) {
6787                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6788                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6789               }
6790             }
6791             if (!valid_qr) {
6792               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6793               for (jj=0;jj<size_of_constraint;jj++) {
6794                 for (ii=0;ii<primal_dofs;ii++) {
6795                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6796                     ierr = 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]));CHKERRQ(ierr);
6797                   }
6798                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6799                     ierr = 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]));CHKERRQ(ierr);
6800                   }
6801                 }
6802               }
6803             } else {
6804               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6805             }
6806           }
6807         } else { /* simple transformation block */
6808           PetscInt    row,col;
6809           PetscScalar val,norm;
6810 
6811           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6812           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6813           for (j=0;j<size_of_constraint;j++) {
6814             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6815             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6816             if (!PetscBTLookup(is_primal,row_B)) {
6817               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6818               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6819               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6820             } else {
6821               for (k=0;k<size_of_constraint;k++) {
6822                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6823                 if (row != col) {
6824                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6825                 } else {
6826                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6827                 }
6828                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6829               }
6830             }
6831           }
6832           if (pcbddc->dbg_flag) {
6833             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6834           }
6835         }
6836       } else {
6837         if (pcbddc->dbg_flag) {
6838           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6839         }
6840       }
6841     }
6842 
6843     /* free workspace */
6844     if (qr_needed) {
6845       if (pcbddc->dbg_flag) {
6846         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6847       }
6848       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6849       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6850       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6851       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6852       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6853     }
6854     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6855     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6856     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6857 
6858     /* assembling of global change of variable */
6859     if (!pcbddc->fake_change) {
6860       Mat      tmat;
6861       PetscInt bs;
6862 
6863       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6864       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6865       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6866       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6867       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6868       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6869       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6870       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6871       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6872       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6873       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6874       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6875       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6876       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6877       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6878       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6879       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6880       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6881       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6882       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6883 
6884       /* check */
6885       if (pcbddc->dbg_flag) {
6886         PetscReal error;
6887         Vec       x,x_change;
6888 
6889         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6890         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6891         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6892         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6893         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6894         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6895         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6896         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6897         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6898         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6899         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6900         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6901         if (error > PETSC_SMALL) {
6902           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6903         }
6904         ierr = VecDestroy(&x);CHKERRQ(ierr);
6905         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6906       }
6907       /* adapt sub_schurs computed (if any) */
6908       if (pcbddc->use_deluxe_scaling) {
6909         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6910 
6911         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");
6912         if (sub_schurs && sub_schurs->S_Ej_all) {
6913           Mat                    S_new,tmat;
6914           IS                     is_all_N,is_V_Sall = NULL;
6915 
6916           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6917           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6918           if (pcbddc->deluxe_zerorows) {
6919             ISLocalToGlobalMapping NtoSall;
6920             IS                     is_V;
6921             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6922             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6923             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6924             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6925             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6926           }
6927           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6928           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6929           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6930           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6931           if (pcbddc->deluxe_zerorows) {
6932             const PetscScalar *array;
6933             const PetscInt    *idxs_V,*idxs_all;
6934             PetscInt          i,n_V;
6935 
6936             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6937             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6938             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6939             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6940             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6941             for (i=0;i<n_V;i++) {
6942               PetscScalar val;
6943               PetscInt    idx;
6944 
6945               idx = idxs_V[i];
6946               val = array[idxs_all[idxs_V[i]]];
6947               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6948             }
6949             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6950             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6951             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6952             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6953             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6954           }
6955           sub_schurs->S_Ej_all = S_new;
6956           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6957           if (sub_schurs->sum_S_Ej_all) {
6958             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6959             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6960             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6961             if (pcbddc->deluxe_zerorows) {
6962               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6963             }
6964             sub_schurs->sum_S_Ej_all = S_new;
6965             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6966           }
6967           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6968           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6969         }
6970         /* destroy any change of basis context in sub_schurs */
6971         if (sub_schurs && sub_schurs->change) {
6972           PetscInt i;
6973 
6974           for (i=0;i<sub_schurs->n_subs;i++) {
6975             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6976           }
6977           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6978         }
6979       }
6980       if (pcbddc->switch_static) { /* need to save the local change */
6981         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6982       } else {
6983         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6984       }
6985       /* determine if any process has changed the pressures locally */
6986       pcbddc->change_interior = pcbddc->benign_have_null;
6987     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6988       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6989       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6990       pcbddc->use_qr_single = qr_needed;
6991     }
6992   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6993     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6994       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6995       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6996     } else {
6997       Mat benign_global = NULL;
6998       if (pcbddc->benign_have_null) {
6999         Mat M;
7000 
7001         pcbddc->change_interior = PETSC_TRUE;
7002         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7003         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7004         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7005         if (pcbddc->benign_change) {
7006           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7007           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7008         } else {
7009           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7010           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7011         }
7012         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7013         ierr = MatDestroy(&M);CHKERRQ(ierr);
7014         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7015         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7016       }
7017       if (pcbddc->user_ChangeOfBasisMatrix) {
7018         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7019         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7020       } else if (pcbddc->benign_have_null) {
7021         pcbddc->ChangeOfBasisMatrix = benign_global;
7022       }
7023     }
7024     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7025       IS             is_global;
7026       const PetscInt *gidxs;
7027 
7028       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7029       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7030       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7031       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7032       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7033     }
7034   }
7035   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7036     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7037   }
7038 
7039   if (!pcbddc->fake_change) {
7040     /* add pressure dofs to set of primal nodes for numbering purposes */
7041     for (i=0;i<pcbddc->benign_n;i++) {
7042       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7043       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7044       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7045       pcbddc->local_primal_size_cc++;
7046       pcbddc->local_primal_size++;
7047     }
7048 
7049     /* check if a new primal space has been introduced (also take into account benign trick) */
7050     pcbddc->new_primal_space_local = PETSC_TRUE;
7051     if (olocal_primal_size == pcbddc->local_primal_size) {
7052       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7053       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7054       if (!pcbddc->new_primal_space_local) {
7055         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7056         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7057       }
7058     }
7059     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7060     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7061   }
7062   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7063 
7064   /* flush dbg viewer */
7065   if (pcbddc->dbg_flag) {
7066     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7067   }
7068 
7069   /* free workspace */
7070   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7071   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7072   if (!pcbddc->adaptive_selection) {
7073     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7074     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7075   } else {
7076     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7077                       pcbddc->adaptive_constraints_idxs_ptr,
7078                       pcbddc->adaptive_constraints_data_ptr,
7079                       pcbddc->adaptive_constraints_idxs,
7080                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7081     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7082     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7083   }
7084   PetscFunctionReturn(0);
7085 }
7086 /* #undef PETSC_MISSING_LAPACK_GESVD */
7087 
7088 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7089 {
7090   ISLocalToGlobalMapping map;
7091   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7092   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7093   PetscInt               i,N;
7094   PetscBool              rcsr = PETSC_FALSE;
7095   PetscErrorCode         ierr;
7096 
7097   PetscFunctionBegin;
7098   if (pcbddc->recompute_topography) {
7099     pcbddc->graphanalyzed = PETSC_FALSE;
7100     /* Reset previously computed graph */
7101     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7102     /* Init local Graph struct */
7103     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7104     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7105     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7106 
7107     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7108       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7109     }
7110     /* Check validity of the csr graph passed in by the user */
7111     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",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
7112 
7113     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7114     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7115       PetscInt  *xadj,*adjncy;
7116       PetscInt  nvtxs;
7117       PetscBool flg_row=PETSC_FALSE;
7118 
7119       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7120       if (flg_row) {
7121         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7122         pcbddc->computed_rowadj = PETSC_TRUE;
7123       }
7124       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7125       rcsr = PETSC_TRUE;
7126     }
7127     if (pcbddc->dbg_flag) {
7128       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7129     }
7130 
7131     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7132       PetscReal    *lcoords;
7133       PetscInt     n;
7134       MPI_Datatype dimrealtype;
7135 
7136       /* TODO: support for blocked */
7137       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
7138       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7139       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7140       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7141       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7142       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7143       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7144       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7145       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7146 
7147       pcbddc->mat_graph->coords = lcoords;
7148       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7149       pcbddc->mat_graph->cnloc  = n;
7150     }
7151     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
7152     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7153 
7154     /* Setup of Graph */
7155     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7156     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7157 
7158     /* attach info on disconnected subdomains if present */
7159     if (pcbddc->n_local_subs) {
7160       PetscInt *local_subs,n,totn;
7161 
7162       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7163       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7164       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7165       for (i=0;i<pcbddc->n_local_subs;i++) {
7166         const PetscInt *idxs;
7167         PetscInt       nl,j;
7168 
7169         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7170         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7171         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7172         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7173       }
7174       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7175       pcbddc->mat_graph->n_local_subs = totn + 1;
7176       pcbddc->mat_graph->local_subs = local_subs;
7177     }
7178   }
7179 
7180   if (!pcbddc->graphanalyzed) {
7181     /* Graph's connected components analysis */
7182     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7183     pcbddc->graphanalyzed = PETSC_TRUE;
7184     pcbddc->corner_selected = pcbddc->corner_selection;
7185   }
7186   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7187   PetscFunctionReturn(0);
7188 }
7189 
7190 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7191 {
7192   PetscInt       i,j;
7193   PetscScalar    *alphas;
7194   PetscReal      norm;
7195   PetscErrorCode ierr;
7196 
7197   PetscFunctionBegin;
7198   if (!n) PetscFunctionReturn(0);
7199   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7200   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7201   if (norm < PETSC_SMALL) {
7202     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7203   }
7204   for (i=1;i<n;i++) {
7205     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7206     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7207     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7208     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7209     if (norm < PETSC_SMALL) {
7210       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7211     }
7212   }
7213   ierr = PetscFree(alphas);CHKERRQ(ierr);
7214   PetscFunctionReturn(0);
7215 }
7216 
7217 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7218 {
7219   Mat            A;
7220   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7221   PetscMPIInt    size,rank,color;
7222   PetscInt       *xadj,*adjncy;
7223   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7224   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7225   PetscInt       void_procs,*procs_candidates = NULL;
7226   PetscInt       xadj_count,*count;
7227   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7228   PetscSubcomm   psubcomm;
7229   MPI_Comm       subcomm;
7230   PetscErrorCode ierr;
7231 
7232   PetscFunctionBegin;
7233   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7234   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7235   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);
7236   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7237   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7238   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7239 
7240   if (have_void) *have_void = PETSC_FALSE;
7241   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7242   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7243   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7244   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7245   im_active = !!n;
7246   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7247   void_procs = size - active_procs;
7248   /* get ranks of of non-active processes in mat communicator */
7249   if (void_procs) {
7250     PetscInt ncand;
7251 
7252     if (have_void) *have_void = PETSC_TRUE;
7253     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7254     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7255     for (i=0,ncand=0;i<size;i++) {
7256       if (!procs_candidates[i]) {
7257         procs_candidates[ncand++] = i;
7258       }
7259     }
7260     /* force n_subdomains to be not greater that the number of non-active processes */
7261     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7262   }
7263 
7264   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7265      number of subdomains requested 1 -> send to master or first candidate in voids  */
7266   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7267   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7268     PetscInt issize,isidx,dest;
7269     if (*n_subdomains == 1) dest = 0;
7270     else dest = rank;
7271     if (im_active) {
7272       issize = 1;
7273       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7274         isidx = procs_candidates[dest];
7275       } else {
7276         isidx = dest;
7277       }
7278     } else {
7279       issize = 0;
7280       isidx = -1;
7281     }
7282     if (*n_subdomains != 1) *n_subdomains = active_procs;
7283     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7284     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7285     PetscFunctionReturn(0);
7286   }
7287   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7288   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7289   threshold = PetscMax(threshold,2);
7290 
7291   /* Get info on mapping */
7292   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7293 
7294   /* build local CSR graph of subdomains' connectivity */
7295   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7296   xadj[0] = 0;
7297   xadj[1] = PetscMax(n_neighs-1,0);
7298   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7299   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7300   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7301   for (i=1;i<n_neighs;i++)
7302     for (j=0;j<n_shared[i];j++)
7303       count[shared[i][j]] += 1;
7304 
7305   xadj_count = 0;
7306   for (i=1;i<n_neighs;i++) {
7307     for (j=0;j<n_shared[i];j++) {
7308       if (count[shared[i][j]] < threshold) {
7309         adjncy[xadj_count] = neighs[i];
7310         adjncy_wgt[xadj_count] = n_shared[i];
7311         xadj_count++;
7312         break;
7313       }
7314     }
7315   }
7316   xadj[1] = xadj_count;
7317   ierr = PetscFree(count);CHKERRQ(ierr);
7318   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7319   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7320 
7321   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7322 
7323   /* Restrict work on active processes only */
7324   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7325   if (void_procs) {
7326     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7327     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7328     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7329     subcomm = PetscSubcommChild(psubcomm);
7330   } else {
7331     psubcomm = NULL;
7332     subcomm = PetscObjectComm((PetscObject)mat);
7333   }
7334 
7335   v_wgt = NULL;
7336   if (!color) {
7337     ierr = PetscFree(xadj);CHKERRQ(ierr);
7338     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7339     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7340   } else {
7341     Mat             subdomain_adj;
7342     IS              new_ranks,new_ranks_contig;
7343     MatPartitioning partitioner;
7344     PetscInt        rstart=0,rend=0;
7345     PetscInt        *is_indices,*oldranks;
7346     PetscMPIInt     size;
7347     PetscBool       aggregate;
7348 
7349     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7350     if (void_procs) {
7351       PetscInt prank = rank;
7352       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7353       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7354       for (i=0;i<xadj[1];i++) {
7355         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7356       }
7357       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7358     } else {
7359       oldranks = NULL;
7360     }
7361     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7362     if (aggregate) { /* TODO: all this part could be made more efficient */
7363       PetscInt    lrows,row,ncols,*cols;
7364       PetscMPIInt nrank;
7365       PetscScalar *vals;
7366 
7367       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7368       lrows = 0;
7369       if (nrank<redprocs) {
7370         lrows = size/redprocs;
7371         if (nrank<size%redprocs) lrows++;
7372       }
7373       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7374       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7375       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7376       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7377       row = nrank;
7378       ncols = xadj[1]-xadj[0];
7379       cols = adjncy;
7380       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7381       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7382       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7383       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7384       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7385       ierr = PetscFree(xadj);CHKERRQ(ierr);
7386       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7387       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7388       ierr = PetscFree(vals);CHKERRQ(ierr);
7389       if (use_vwgt) {
7390         Vec               v;
7391         const PetscScalar *array;
7392         PetscInt          nl;
7393 
7394         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7395         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7396         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7397         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7398         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7399         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7400         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7401         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7402         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7403         ierr = VecDestroy(&v);CHKERRQ(ierr);
7404       }
7405     } else {
7406       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7407       if (use_vwgt) {
7408         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7409         v_wgt[0] = n;
7410       }
7411     }
7412     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7413 
7414     /* Partition */
7415     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7416 #if defined(PETSC_HAVE_PTSCOTCH)
7417     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7418 #elif defined(PETSC_HAVE_PARMETIS)
7419     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7420 #else
7421     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7422 #endif
7423     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7424     if (v_wgt) {
7425       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7426     }
7427     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7428     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7429     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7430     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7431     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7432 
7433     /* renumber new_ranks to avoid "holes" in new set of processors */
7434     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7435     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7436     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7437     if (!aggregate) {
7438       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7439 #if defined(PETSC_USE_DEBUG)
7440         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7441 #endif
7442         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7443       } else if (oldranks) {
7444         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7445       } else {
7446         ranks_send_to_idx[0] = is_indices[0];
7447       }
7448     } else {
7449       PetscInt    idx = 0;
7450       PetscMPIInt tag;
7451       MPI_Request *reqs;
7452 
7453       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7454       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7455       for (i=rstart;i<rend;i++) {
7456         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7457       }
7458       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7459       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7460       ierr = PetscFree(reqs);CHKERRQ(ierr);
7461       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7462 #if defined(PETSC_USE_DEBUG)
7463         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7464 #endif
7465         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7466       } else if (oldranks) {
7467         ranks_send_to_idx[0] = oldranks[idx];
7468       } else {
7469         ranks_send_to_idx[0] = idx;
7470       }
7471     }
7472     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7473     /* clean up */
7474     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7475     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7476     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7477     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7478   }
7479   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7480   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7481 
7482   /* assemble parallel IS for sends */
7483   i = 1;
7484   if (!color) i=0;
7485   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7486   PetscFunctionReturn(0);
7487 }
7488 
7489 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7490 
7491 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[])
7492 {
7493   Mat                    local_mat;
7494   IS                     is_sends_internal;
7495   PetscInt               rows,cols,new_local_rows;
7496   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7497   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7498   ISLocalToGlobalMapping l2gmap;
7499   PetscInt*              l2gmap_indices;
7500   const PetscInt*        is_indices;
7501   MatType                new_local_type;
7502   /* buffers */
7503   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7504   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7505   PetscInt               *recv_buffer_idxs_local;
7506   PetscScalar            *ptr_vals,*recv_buffer_vals;
7507   const PetscScalar      *send_buffer_vals;
7508   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7509   /* MPI */
7510   MPI_Comm               comm,comm_n;
7511   PetscSubcomm           subcomm;
7512   PetscMPIInt            n_sends,n_recvs,size;
7513   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7514   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7515   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7516   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7517   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7518   PetscErrorCode         ierr;
7519 
7520   PetscFunctionBegin;
7521   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7522   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7523   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);
7524   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7525   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7526   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7527   PetscValidLogicalCollectiveBool(mat,reuse,6);
7528   PetscValidLogicalCollectiveInt(mat,nis,8);
7529   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7530   if (nvecs) {
7531     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7532     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7533   }
7534   /* further checks */
7535   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7536   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7537   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7538   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7539   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7540   if (reuse && *mat_n) {
7541     PetscInt mrows,mcols,mnrows,mncols;
7542     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7543     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7544     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7545     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7546     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7547     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7548     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7549   }
7550   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7551   PetscValidLogicalCollectiveInt(mat,bs,0);
7552 
7553   /* prepare IS for sending if not provided */
7554   if (!is_sends) {
7555     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7556     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7557   } else {
7558     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7559     is_sends_internal = is_sends;
7560   }
7561 
7562   /* get comm */
7563   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7564 
7565   /* compute number of sends */
7566   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7567   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7568 
7569   /* compute number of receives */
7570   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7571   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7572   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7573   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7574   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7575   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7576   ierr = PetscFree(iflags);CHKERRQ(ierr);
7577 
7578   /* restrict comm if requested */
7579   subcomm = 0;
7580   destroy_mat = PETSC_FALSE;
7581   if (restrict_comm) {
7582     PetscMPIInt color,subcommsize;
7583 
7584     color = 0;
7585     if (restrict_full) {
7586       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7587     } else {
7588       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7589     }
7590     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7591     subcommsize = size - subcommsize;
7592     /* check if reuse has been requested */
7593     if (reuse) {
7594       if (*mat_n) {
7595         PetscMPIInt subcommsize2;
7596         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7597         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7598         comm_n = PetscObjectComm((PetscObject)*mat_n);
7599       } else {
7600         comm_n = PETSC_COMM_SELF;
7601       }
7602     } else { /* MAT_INITIAL_MATRIX */
7603       PetscMPIInt rank;
7604 
7605       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7606       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7607       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7608       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7609       comm_n = PetscSubcommChild(subcomm);
7610     }
7611     /* flag to destroy *mat_n if not significative */
7612     if (color) destroy_mat = PETSC_TRUE;
7613   } else {
7614     comm_n = comm;
7615   }
7616 
7617   /* prepare send/receive buffers */
7618   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7619   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7620   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7621   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7622   if (nis) {
7623     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7624   }
7625 
7626   /* Get data from local matrices */
7627   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7628     /* TODO: See below some guidelines on how to prepare the local buffers */
7629     /*
7630        send_buffer_vals should contain the raw values of the local matrix
7631        send_buffer_idxs should contain:
7632        - MatType_PRIVATE type
7633        - PetscInt        size_of_l2gmap
7634        - PetscInt        global_row_indices[size_of_l2gmap]
7635        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7636     */
7637   else {
7638     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7639     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7640     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7641     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7642     send_buffer_idxs[1] = i;
7643     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7644     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7645     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7646     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7647     for (i=0;i<n_sends;i++) {
7648       ilengths_vals[is_indices[i]] = len*len;
7649       ilengths_idxs[is_indices[i]] = len+2;
7650     }
7651   }
7652   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7653   /* additional is (if any) */
7654   if (nis) {
7655     PetscMPIInt psum;
7656     PetscInt j;
7657     for (j=0,psum=0;j<nis;j++) {
7658       PetscInt plen;
7659       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7660       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7661       psum += len+1; /* indices + lenght */
7662     }
7663     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7664     for (j=0,psum=0;j<nis;j++) {
7665       PetscInt plen;
7666       const PetscInt *is_array_idxs;
7667       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7668       send_buffer_idxs_is[psum] = plen;
7669       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7670       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7671       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7672       psum += plen+1; /* indices + lenght */
7673     }
7674     for (i=0;i<n_sends;i++) {
7675       ilengths_idxs_is[is_indices[i]] = psum;
7676     }
7677     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7678   }
7679   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7680 
7681   buf_size_idxs = 0;
7682   buf_size_vals = 0;
7683   buf_size_idxs_is = 0;
7684   buf_size_vecs = 0;
7685   for (i=0;i<n_recvs;i++) {
7686     buf_size_idxs += (PetscInt)olengths_idxs[i];
7687     buf_size_vals += (PetscInt)olengths_vals[i];
7688     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7689     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7690   }
7691   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7692   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7693   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7694   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7695 
7696   /* get new tags for clean communications */
7697   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7698   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7699   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7700   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7701 
7702   /* allocate for requests */
7703   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7704   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7705   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7706   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7707   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7708   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7709   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7710   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7711 
7712   /* communications */
7713   ptr_idxs = recv_buffer_idxs;
7714   ptr_vals = recv_buffer_vals;
7715   ptr_idxs_is = recv_buffer_idxs_is;
7716   ptr_vecs = recv_buffer_vecs;
7717   for (i=0;i<n_recvs;i++) {
7718     source_dest = onodes[i];
7719     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7720     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7721     ptr_idxs += olengths_idxs[i];
7722     ptr_vals += olengths_vals[i];
7723     if (nis) {
7724       source_dest = onodes_is[i];
7725       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);
7726       ptr_idxs_is += olengths_idxs_is[i];
7727     }
7728     if (nvecs) {
7729       source_dest = onodes[i];
7730       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7731       ptr_vecs += olengths_idxs[i]-2;
7732     }
7733   }
7734   for (i=0;i<n_sends;i++) {
7735     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7736     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7737     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7738     if (nis) {
7739       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);
7740     }
7741     if (nvecs) {
7742       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7743       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7744     }
7745   }
7746   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7747   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7748 
7749   /* assemble new l2g map */
7750   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7751   ptr_idxs = recv_buffer_idxs;
7752   new_local_rows = 0;
7753   for (i=0;i<n_recvs;i++) {
7754     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7755     ptr_idxs += olengths_idxs[i];
7756   }
7757   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7758   ptr_idxs = recv_buffer_idxs;
7759   new_local_rows = 0;
7760   for (i=0;i<n_recvs;i++) {
7761     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7762     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7763     ptr_idxs += olengths_idxs[i];
7764   }
7765   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7766   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7767   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7768 
7769   /* infer new local matrix type from received local matrices type */
7770   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7771   /* 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) */
7772   if (n_recvs) {
7773     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7774     ptr_idxs = recv_buffer_idxs;
7775     for (i=0;i<n_recvs;i++) {
7776       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7777         new_local_type_private = MATAIJ_PRIVATE;
7778         break;
7779       }
7780       ptr_idxs += olengths_idxs[i];
7781     }
7782     switch (new_local_type_private) {
7783       case MATDENSE_PRIVATE:
7784         new_local_type = MATSEQAIJ;
7785         bs = 1;
7786         break;
7787       case MATAIJ_PRIVATE:
7788         new_local_type = MATSEQAIJ;
7789         bs = 1;
7790         break;
7791       case MATBAIJ_PRIVATE:
7792         new_local_type = MATSEQBAIJ;
7793         break;
7794       case MATSBAIJ_PRIVATE:
7795         new_local_type = MATSEQSBAIJ;
7796         break;
7797       default:
7798         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7799         break;
7800     }
7801   } else { /* by default, new_local_type is seqaij */
7802     new_local_type = MATSEQAIJ;
7803     bs = 1;
7804   }
7805 
7806   /* create MATIS object if needed */
7807   if (!reuse) {
7808     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7809     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7810   } else {
7811     /* it also destroys the local matrices */
7812     if (*mat_n) {
7813       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7814     } else { /* this is a fake object */
7815       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7816     }
7817   }
7818   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7819   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7820 
7821   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7822 
7823   /* Global to local map of received indices */
7824   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7825   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7826   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7827 
7828   /* restore attributes -> type of incoming data and its size */
7829   buf_size_idxs = 0;
7830   for (i=0;i<n_recvs;i++) {
7831     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7832     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7833     buf_size_idxs += (PetscInt)olengths_idxs[i];
7834   }
7835   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7836 
7837   /* set preallocation */
7838   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7839   if (!newisdense) {
7840     PetscInt *new_local_nnz=0;
7841 
7842     ptr_idxs = recv_buffer_idxs_local;
7843     if (n_recvs) {
7844       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7845     }
7846     for (i=0;i<n_recvs;i++) {
7847       PetscInt j;
7848       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7849         for (j=0;j<*(ptr_idxs+1);j++) {
7850           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7851         }
7852       } else {
7853         /* TODO */
7854       }
7855       ptr_idxs += olengths_idxs[i];
7856     }
7857     if (new_local_nnz) {
7858       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7859       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7860       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7861       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7862       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7863       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7864     } else {
7865       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7866     }
7867     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7868   } else {
7869     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7870   }
7871 
7872   /* set values */
7873   ptr_vals = recv_buffer_vals;
7874   ptr_idxs = recv_buffer_idxs_local;
7875   for (i=0;i<n_recvs;i++) {
7876     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7877       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7878       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7879       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7880       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7881       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7882     } else {
7883       /* TODO */
7884     }
7885     ptr_idxs += olengths_idxs[i];
7886     ptr_vals += olengths_vals[i];
7887   }
7888   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7889   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7890   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7891   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7892   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7893   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7894 
7895 #if 0
7896   if (!restrict_comm) { /* check */
7897     Vec       lvec,rvec;
7898     PetscReal infty_error;
7899 
7900     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7901     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7902     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7903     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7904     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7905     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7906     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7907     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7908     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7909   }
7910 #endif
7911 
7912   /* assemble new additional is (if any) */
7913   if (nis) {
7914     PetscInt **temp_idxs,*count_is,j,psum;
7915 
7916     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7917     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7918     ptr_idxs = recv_buffer_idxs_is;
7919     psum = 0;
7920     for (i=0;i<n_recvs;i++) {
7921       for (j=0;j<nis;j++) {
7922         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7923         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7924         psum += plen;
7925         ptr_idxs += plen+1; /* shift pointer to received data */
7926       }
7927     }
7928     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7929     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7930     for (i=1;i<nis;i++) {
7931       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7932     }
7933     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
7934     ptr_idxs = recv_buffer_idxs_is;
7935     for (i=0;i<n_recvs;i++) {
7936       for (j=0;j<nis;j++) {
7937         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7938         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
7939         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7940         ptr_idxs += plen+1; /* shift pointer to received data */
7941       }
7942     }
7943     for (i=0;i<nis;i++) {
7944       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7945       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7946       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7947     }
7948     ierr = PetscFree(count_is);CHKERRQ(ierr);
7949     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7950     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7951   }
7952   /* free workspace */
7953   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7954   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7955   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7956   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7957   if (isdense) {
7958     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7959     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7960     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7961   } else {
7962     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7963   }
7964   if (nis) {
7965     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7966     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7967   }
7968 
7969   if (nvecs) {
7970     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7971     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7972     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7973     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7974     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7975     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7976     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7977     /* set values */
7978     ptr_vals = recv_buffer_vecs;
7979     ptr_idxs = recv_buffer_idxs_local;
7980     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7981     for (i=0;i<n_recvs;i++) {
7982       PetscInt j;
7983       for (j=0;j<*(ptr_idxs+1);j++) {
7984         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7985       }
7986       ptr_idxs += olengths_idxs[i];
7987       ptr_vals += olengths_idxs[i]-2;
7988     }
7989     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7990     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7991     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7992   }
7993 
7994   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7995   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7996   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7997   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7998   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7999   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8000   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8001   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8002   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8003   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8004   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8005   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8006   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8007   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8008   ierr = PetscFree(onodes);CHKERRQ(ierr);
8009   if (nis) {
8010     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8011     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8012     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8013   }
8014   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8015   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8016     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8017     for (i=0;i<nis;i++) {
8018       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8019     }
8020     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8021       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8022     }
8023     *mat_n = NULL;
8024   }
8025   PetscFunctionReturn(0);
8026 }
8027 
8028 /* temporary hack into ksp private data structure */
8029 #include <petsc/private/kspimpl.h>
8030 
8031 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8032 {
8033   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8034   PC_IS                  *pcis = (PC_IS*)pc->data;
8035   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8036   Mat                    coarsedivudotp = NULL;
8037   Mat                    coarseG,t_coarse_mat_is;
8038   MatNullSpace           CoarseNullSpace = NULL;
8039   ISLocalToGlobalMapping coarse_islg;
8040   IS                     coarse_is,*isarray,corners;
8041   PetscInt               i,im_active=-1,active_procs=-1;
8042   PetscInt               nis,nisdofs,nisneu,nisvert;
8043   PetscInt               coarse_eqs_per_proc;
8044   PC                     pc_temp;
8045   PCType                 coarse_pc_type;
8046   KSPType                coarse_ksp_type;
8047   PetscBool              multilevel_requested,multilevel_allowed;
8048   PetscBool              coarse_reuse;
8049   PetscInt               ncoarse,nedcfield;
8050   PetscBool              compute_vecs = PETSC_FALSE;
8051   PetscScalar            *array;
8052   MatReuse               coarse_mat_reuse;
8053   PetscBool              restr, full_restr, have_void;
8054   PetscMPIInt            size;
8055   PetscErrorCode         ierr;
8056 
8057   PetscFunctionBegin;
8058   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8059   /* Assign global numbering to coarse dofs */
8060   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 */
8061     PetscInt ocoarse_size;
8062     compute_vecs = PETSC_TRUE;
8063 
8064     pcbddc->new_primal_space = PETSC_TRUE;
8065     ocoarse_size = pcbddc->coarse_size;
8066     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8067     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8068     /* see if we can avoid some work */
8069     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8070       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8071       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8072         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8073         coarse_reuse = PETSC_FALSE;
8074       } else { /* we can safely reuse already computed coarse matrix */
8075         coarse_reuse = PETSC_TRUE;
8076       }
8077     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8078       coarse_reuse = PETSC_FALSE;
8079     }
8080     /* reset any subassembling information */
8081     if (!coarse_reuse || pcbddc->recompute_topography) {
8082       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8083     }
8084   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8085     coarse_reuse = PETSC_TRUE;
8086   }
8087   if (coarse_reuse && pcbddc->coarse_ksp) {
8088     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8089     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8090     coarse_mat_reuse = MAT_REUSE_MATRIX;
8091   } else {
8092     coarse_mat = NULL;
8093     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8094   }
8095 
8096   /* creates temporary l2gmap and IS for coarse indexes */
8097   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8098   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8099 
8100   /* creates temporary MATIS object for coarse matrix */
8101   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8102   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);
8103   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8104   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8105   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8106   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8107 
8108   /* count "active" (i.e. with positive local size) and "void" processes */
8109   im_active = !!(pcis->n);
8110   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8111 
8112   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8113   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8114   /* full_restr : just use the receivers from the subassembling pattern */
8115   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8116   coarse_mat_is        = NULL;
8117   multilevel_allowed   = PETSC_FALSE;
8118   multilevel_requested = PETSC_FALSE;
8119   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8120   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8121   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8122   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8123   if (multilevel_requested) {
8124     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8125     restr      = PETSC_FALSE;
8126     full_restr = PETSC_FALSE;
8127   } else {
8128     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8129     restr      = PETSC_TRUE;
8130     full_restr = PETSC_TRUE;
8131   }
8132   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8133   ncoarse = PetscMax(1,ncoarse);
8134   if (!pcbddc->coarse_subassembling) {
8135     if (pcbddc->coarsening_ratio > 1) {
8136       if (multilevel_requested) {
8137         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8138       } else {
8139         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8140       }
8141     } else {
8142       PetscMPIInt rank;
8143       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8144       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8145       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8146     }
8147   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8148     PetscInt    psum;
8149     if (pcbddc->coarse_ksp) psum = 1;
8150     else psum = 0;
8151     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8152     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8153   }
8154   /* determine if we can go multilevel */
8155   if (multilevel_requested) {
8156     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8157     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8158   }
8159   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8160 
8161   /* dump subassembling pattern */
8162   if (pcbddc->dbg_flag && multilevel_allowed) {
8163     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8164   }
8165   /* compute dofs splitting and neumann boundaries for coarse dofs */
8166   nedcfield = -1;
8167   corners = NULL;
8168   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8169     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8170     const PetscInt         *idxs;
8171     ISLocalToGlobalMapping tmap;
8172 
8173     /* create map between primal indices (in local representative ordering) and local primal numbering */
8174     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8175     /* allocate space for temporary storage */
8176     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8177     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8178     /* allocate for IS array */
8179     nisdofs = pcbddc->n_ISForDofsLocal;
8180     if (pcbddc->nedclocal) {
8181       if (pcbddc->nedfield > -1) {
8182         nedcfield = pcbddc->nedfield;
8183       } else {
8184         nedcfield = 0;
8185         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8186         nisdofs = 1;
8187       }
8188     }
8189     nisneu = !!pcbddc->NeumannBoundariesLocal;
8190     nisvert = 0; /* nisvert is not used */
8191     nis = nisdofs + nisneu + nisvert;
8192     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8193     /* dofs splitting */
8194     for (i=0;i<nisdofs;i++) {
8195       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8196       if (nedcfield != i) {
8197         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8198         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8199         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8200         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8201       } else {
8202         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8203         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8204         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8205         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8206         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8207       }
8208       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8209       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8210       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8211     }
8212     /* neumann boundaries */
8213     if (pcbddc->NeumannBoundariesLocal) {
8214       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8215       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8216       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8217       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8218       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8219       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8220       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8221       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8222     }
8223     /* coordinates */
8224     if (pcbddc->corner_selected) {
8225       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8226       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8227       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8228       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8229       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8230       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8231       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8232       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8233       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8234     }
8235     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8236     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8237     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8238   } else {
8239     nis = 0;
8240     nisdofs = 0;
8241     nisneu = 0;
8242     nisvert = 0;
8243     isarray = NULL;
8244   }
8245   /* destroy no longer needed map */
8246   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8247 
8248   /* subassemble */
8249   if (multilevel_allowed) {
8250     Vec       vp[1];
8251     PetscInt  nvecs = 0;
8252     PetscBool reuse,reuser;
8253 
8254     if (coarse_mat) reuse = PETSC_TRUE;
8255     else reuse = PETSC_FALSE;
8256     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8257     vp[0] = NULL;
8258     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8259       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8260       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8261       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8262       nvecs = 1;
8263 
8264       if (pcbddc->divudotp) {
8265         Mat      B,loc_divudotp;
8266         Vec      v,p;
8267         IS       dummy;
8268         PetscInt np;
8269 
8270         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8271         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8272         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8273         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8274         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8275         ierr = VecSet(p,1.);CHKERRQ(ierr);
8276         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8277         ierr = VecDestroy(&p);CHKERRQ(ierr);
8278         ierr = MatDestroy(&B);CHKERRQ(ierr);
8279         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8280         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8281         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8282         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8283         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8284         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8285         ierr = VecDestroy(&v);CHKERRQ(ierr);
8286       }
8287     }
8288     if (reuser) {
8289       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8290     } else {
8291       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8292     }
8293     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8294       PetscScalar       *arraym;
8295       const PetscScalar *arrayv;
8296       PetscInt          nl;
8297       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8298       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8299       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8300       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8301       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8302       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8303       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8304       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8305     } else {
8306       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8307     }
8308   } else {
8309     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8310   }
8311   if (coarse_mat_is || coarse_mat) {
8312     if (!multilevel_allowed) {
8313       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8314     } else {
8315       Mat A;
8316 
8317       /* if this matrix is present, it means we are not reusing the coarse matrix */
8318       if (coarse_mat_is) {
8319         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8320         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8321         coarse_mat = coarse_mat_is;
8322       }
8323       /* be sure we don't have MatSeqDENSE as local mat */
8324       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8325       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8326     }
8327   }
8328   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8329   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8330 
8331   /* create local to global scatters for coarse problem */
8332   if (compute_vecs) {
8333     PetscInt lrows;
8334     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8335     if (coarse_mat) {
8336       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8337     } else {
8338       lrows = 0;
8339     }
8340     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8341     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8342     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8343     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8344     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8345   }
8346   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8347 
8348   /* set defaults for coarse KSP and PC */
8349   if (multilevel_allowed) {
8350     coarse_ksp_type = KSPRICHARDSON;
8351     coarse_pc_type  = PCBDDC;
8352   } else {
8353     coarse_ksp_type = KSPPREONLY;
8354     coarse_pc_type  = PCREDUNDANT;
8355   }
8356 
8357   /* print some info if requested */
8358   if (pcbddc->dbg_flag) {
8359     if (!multilevel_allowed) {
8360       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8361       if (multilevel_requested) {
8362         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);
8363       } else if (pcbddc->max_levels) {
8364         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8365       }
8366       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8367     }
8368   }
8369 
8370   /* communicate coarse discrete gradient */
8371   coarseG = NULL;
8372   if (pcbddc->nedcG && multilevel_allowed) {
8373     MPI_Comm ccomm;
8374     if (coarse_mat) {
8375       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8376     } else {
8377       ccomm = MPI_COMM_NULL;
8378     }
8379     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8380   }
8381 
8382   /* create the coarse KSP object only once with defaults */
8383   if (coarse_mat) {
8384     PetscBool   isredundant,isnn,isbddc;
8385     PetscViewer dbg_viewer = NULL;
8386 
8387     if (pcbddc->dbg_flag) {
8388       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8389       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8390     }
8391     if (!pcbddc->coarse_ksp) {
8392       char   prefix[256],str_level[16];
8393       size_t len;
8394 
8395       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8396       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8397       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8398       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8399       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8400       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8401       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8402       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8403       /* TODO is this logic correct? should check for coarse_mat type */
8404       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8405       /* prefix */
8406       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8407       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8408       if (!pcbddc->current_level) {
8409         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8410         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8411       } else {
8412         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8413         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8414         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8415         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8416         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8417         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8418         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8419       }
8420       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8421       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8422       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8423       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8424       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8425       /* allow user customization */
8426       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8427       /* get some info after set from options */
8428       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8429       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8430       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8431       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8432       if (multilevel_allowed && !isbddc && !isnn) {
8433         isbddc = PETSC_TRUE;
8434         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8435         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8436         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8437         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8438         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8439           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8440           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8441           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8442           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8443           pc_temp->setfromoptionscalled++;
8444         }
8445       }
8446     }
8447     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8448     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8449     if (nisdofs) {
8450       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8451       for (i=0;i<nisdofs;i++) {
8452         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8453       }
8454     }
8455     if (nisneu) {
8456       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8457       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8458     }
8459     if (nisvert) {
8460       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8461       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8462     }
8463     if (coarseG) {
8464       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8465     }
8466 
8467     /* get some info after set from options */
8468     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8469 
8470     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8471     if (isbddc && !multilevel_allowed) {
8472       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8473       isbddc = PETSC_FALSE;
8474     }
8475     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8476     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8477     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8478       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8479       isbddc = PETSC_TRUE;
8480     }
8481     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8482     if (isredundant) {
8483       KSP inner_ksp;
8484       PC  inner_pc;
8485 
8486       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8487       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8488     }
8489 
8490     /* parameters which miss an API */
8491     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8492     if (isbddc) {
8493       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8494 
8495       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8496       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8497       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8498       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8499       if (pcbddc_coarse->benign_saddle_point) {
8500         Mat                    coarsedivudotp_is;
8501         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8502         IS                     row,col;
8503         const PetscInt         *gidxs;
8504         PetscInt               n,st,M,N;
8505 
8506         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8507         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8508         st   = st-n;
8509         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8510         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8511         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8512         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8513         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8514         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8515         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8516         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8517         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8518         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8519         ierr = ISDestroy(&row);CHKERRQ(ierr);
8520         ierr = ISDestroy(&col);CHKERRQ(ierr);
8521         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8522         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8523         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8524         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8525         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8526         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8527         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8528         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8529         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8530         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8531         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8532         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8533       }
8534     }
8535 
8536     /* propagate symmetry info of coarse matrix */
8537     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8538     if (pc->pmat->symmetric_set) {
8539       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8540     }
8541     if (pc->pmat->hermitian_set) {
8542       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8543     }
8544     if (pc->pmat->spd_set) {
8545       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8546     }
8547     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8548       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8549     }
8550     /* set operators */
8551     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8552     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8553     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8554     if (pcbddc->dbg_flag) {
8555       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8556     }
8557   }
8558   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8559   ierr = PetscFree(isarray);CHKERRQ(ierr);
8560 #if 0
8561   {
8562     PetscViewer viewer;
8563     char filename[256];
8564     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8565     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8566     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8567     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8568     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8569     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8570   }
8571 #endif
8572 
8573   if (corners) {
8574     Vec            gv;
8575     IS             is;
8576     const PetscInt *idxs;
8577     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8578     PetscScalar    *coords;
8579 
8580     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8581     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8582     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8583     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8584     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8585     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8586     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8587     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8588     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8589 
8590     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8591     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8592     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8593     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8594     for (i=0;i<n;i++) {
8595       for (d=0;d<cdim;d++) {
8596         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8597       }
8598     }
8599     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8600     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8601 
8602     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8603     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8604     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8605     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8606     ierr = PetscFree(coords);CHKERRQ(ierr);
8607     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8608     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8609     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8610     if (pcbddc->coarse_ksp) {
8611       PC        coarse_pc;
8612       PetscBool isbddc;
8613 
8614       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8615       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8616       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8617         PetscReal *realcoords;
8618 
8619         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8620 #if defined(PETSC_USE_COMPLEX)
8621         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8622         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8623 #else
8624         realcoords = coords;
8625 #endif
8626         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8627 #if defined(PETSC_USE_COMPLEX)
8628         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8629 #endif
8630       }
8631     }
8632     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8633     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8634   }
8635   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8636 
8637   if (pcbddc->coarse_ksp) {
8638     Vec crhs,csol;
8639 
8640     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8641     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8642     if (!csol) {
8643       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8644     }
8645     if (!crhs) {
8646       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8647     }
8648   }
8649   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8650 
8651   /* compute null space for coarse solver if the benign trick has been requested */
8652   if (pcbddc->benign_null) {
8653 
8654     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8655     for (i=0;i<pcbddc->benign_n;i++) {
8656       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8657     }
8658     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8659     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8660     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8661     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8662     if (coarse_mat) {
8663       Vec         nullv;
8664       PetscScalar *array,*array2;
8665       PetscInt    nl;
8666 
8667       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8668       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8669       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8670       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8671       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8672       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8673       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8674       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8675       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8676       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8677     }
8678   }
8679   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8680 
8681   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8682   if (pcbddc->coarse_ksp) {
8683     PetscBool ispreonly;
8684 
8685     if (CoarseNullSpace) {
8686       PetscBool isnull;
8687       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8688       if (isnull) {
8689         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8690       }
8691       /* TODO: add local nullspaces (if any) */
8692     }
8693     /* setup coarse ksp */
8694     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8695     /* Check coarse problem if in debug mode or if solving with an iterative method */
8696     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8697     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8698       KSP       check_ksp;
8699       KSPType   check_ksp_type;
8700       PC        check_pc;
8701       Vec       check_vec,coarse_vec;
8702       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8703       PetscInt  its;
8704       PetscBool compute_eigs;
8705       PetscReal *eigs_r,*eigs_c;
8706       PetscInt  neigs;
8707       const char *prefix;
8708 
8709       /* Create ksp object suitable for estimation of extreme eigenvalues */
8710       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8711       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8712       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8713       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8714       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8715       /* prevent from setup unneeded object */
8716       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8717       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8718       if (ispreonly) {
8719         check_ksp_type = KSPPREONLY;
8720         compute_eigs = PETSC_FALSE;
8721       } else {
8722         check_ksp_type = KSPGMRES;
8723         compute_eigs = PETSC_TRUE;
8724       }
8725       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8726       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8727       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8728       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8729       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8730       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8731       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8732       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8733       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8734       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8735       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8736       /* create random vec */
8737       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8738       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8739       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8740       /* solve coarse problem */
8741       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8742       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8743       /* set eigenvalue estimation if preonly has not been requested */
8744       if (compute_eigs) {
8745         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8746         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8747         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8748         if (neigs) {
8749           lambda_max = eigs_r[neigs-1];
8750           lambda_min = eigs_r[0];
8751           if (pcbddc->use_coarse_estimates) {
8752             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8753               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8754               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8755             }
8756           }
8757         }
8758       }
8759 
8760       /* check coarse problem residual error */
8761       if (pcbddc->dbg_flag) {
8762         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8763         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8764         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8765         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8766         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8767         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8768         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8769         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8770         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8771         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8772         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8773         if (CoarseNullSpace) {
8774           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8775         }
8776         if (compute_eigs) {
8777           PetscReal          lambda_max_s,lambda_min_s;
8778           KSPConvergedReason reason;
8779           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8780           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8781           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8782           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8783           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);
8784           for (i=0;i<neigs;i++) {
8785             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8786           }
8787         }
8788         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8789         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8790       }
8791       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8792       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8793       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8794       if (compute_eigs) {
8795         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8796         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8797       }
8798     }
8799   }
8800   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8801   /* print additional info */
8802   if (pcbddc->dbg_flag) {
8803     /* waits until all processes reaches this point */
8804     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8806     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8807   }
8808 
8809   /* free memory */
8810   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8811   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8812   PetscFunctionReturn(0);
8813 }
8814 
8815 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8816 {
8817   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8818   PC_IS*         pcis = (PC_IS*)pc->data;
8819   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8820   IS             subset,subset_mult,subset_n;
8821   PetscInt       local_size,coarse_size=0;
8822   PetscInt       *local_primal_indices=NULL;
8823   const PetscInt *t_local_primal_indices;
8824   PetscErrorCode ierr;
8825 
8826   PetscFunctionBegin;
8827   /* Compute global number of coarse dofs */
8828   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8829   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8830   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8831   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8832   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8833   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8834   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8835   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8836   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8837   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);
8838   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8839   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8840   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8841   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8842   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8843 
8844   /* check numbering */
8845   if (pcbddc->dbg_flag) {
8846     PetscScalar coarsesum,*array,*array2;
8847     PetscInt    i;
8848     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8849 
8850     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8851     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8852     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8853     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8854     /* counter */
8855     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8856     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8857     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8858     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8859     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8860     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8861     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8862     for (i=0;i<pcbddc->local_primal_size;i++) {
8863       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8864     }
8865     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8866     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8867     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8868     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8869     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8870     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8871     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8872     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8873     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8874     for (i=0;i<pcis->n;i++) {
8875       if (array[i] != 0.0 && array[i] != array2[i]) {
8876         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8877         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8878         set_error = PETSC_TRUE;
8879         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8880         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);
8881       }
8882     }
8883     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8884     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8885     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8886     for (i=0;i<pcis->n;i++) {
8887       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8888     }
8889     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8890     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8891     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8892     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8893     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8894     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8895     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8896       PetscInt *gidxs;
8897 
8898       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8899       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8900       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8901       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8902       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8903       for (i=0;i<pcbddc->local_primal_size;i++) {
8904         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);
8905       }
8906       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8907       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8908     }
8909     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8910     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8911     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8912   }
8913 
8914   /* get back data */
8915   *coarse_size_n = coarse_size;
8916   *local_primal_indices_n = local_primal_indices;
8917   PetscFunctionReturn(0);
8918 }
8919 
8920 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8921 {
8922   IS             localis_t;
8923   PetscInt       i,lsize,*idxs,n;
8924   PetscScalar    *vals;
8925   PetscErrorCode ierr;
8926 
8927   PetscFunctionBegin;
8928   /* get indices in local ordering exploiting local to global map */
8929   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8930   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8931   for (i=0;i<lsize;i++) vals[i] = 1.0;
8932   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8933   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8934   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8935   if (idxs) { /* multilevel guard */
8936     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8937     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8938   }
8939   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8940   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8941   ierr = PetscFree(vals);CHKERRQ(ierr);
8942   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8943   /* now compute set in local ordering */
8944   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8945   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8946   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8947   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8948   for (i=0,lsize=0;i<n;i++) {
8949     if (PetscRealPart(vals[i]) > 0.5) {
8950       lsize++;
8951     }
8952   }
8953   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8954   for (i=0,lsize=0;i<n;i++) {
8955     if (PetscRealPart(vals[i]) > 0.5) {
8956       idxs[lsize++] = i;
8957     }
8958   }
8959   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8960   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8961   *localis = localis_t;
8962   PetscFunctionReturn(0);
8963 }
8964 
8965 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8966 {
8967   PC_IS               *pcis=(PC_IS*)pc->data;
8968   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8969   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8970   Mat                 S_j;
8971   PetscInt            *used_xadj,*used_adjncy;
8972   PetscBool           free_used_adj;
8973   PetscErrorCode      ierr;
8974 
8975   PetscFunctionBegin;
8976   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8977   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8978   free_used_adj = PETSC_FALSE;
8979   if (pcbddc->sub_schurs_layers == -1) {
8980     used_xadj = NULL;
8981     used_adjncy = NULL;
8982   } else {
8983     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8984       used_xadj = pcbddc->mat_graph->xadj;
8985       used_adjncy = pcbddc->mat_graph->adjncy;
8986     } else if (pcbddc->computed_rowadj) {
8987       used_xadj = pcbddc->mat_graph->xadj;
8988       used_adjncy = pcbddc->mat_graph->adjncy;
8989     } else {
8990       PetscBool      flg_row=PETSC_FALSE;
8991       const PetscInt *xadj,*adjncy;
8992       PetscInt       nvtxs;
8993 
8994       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8995       if (flg_row) {
8996         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8997         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
8998         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
8999         free_used_adj = PETSC_TRUE;
9000       } else {
9001         pcbddc->sub_schurs_layers = -1;
9002         used_xadj = NULL;
9003         used_adjncy = NULL;
9004       }
9005       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9006     }
9007   }
9008 
9009   /* setup sub_schurs data */
9010   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9011   if (!sub_schurs->schur_explicit) {
9012     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9013     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9014     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);
9015   } else {
9016     Mat       change = NULL;
9017     Vec       scaling = NULL;
9018     IS        change_primal = NULL, iP;
9019     PetscInt  benign_n;
9020     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9021     PetscBool isseqaij,need_change = PETSC_FALSE;
9022     PetscBool discrete_harmonic = PETSC_FALSE;
9023 
9024     if (!pcbddc->use_vertices && reuse_solvers) {
9025       PetscInt n_vertices;
9026 
9027       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9028       reuse_solvers = (PetscBool)!n_vertices;
9029     }
9030     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
9031     if (!isseqaij) {
9032       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
9033       if (matis->A == pcbddc->local_mat) {
9034         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
9035         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9036       } else {
9037         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9038       }
9039     }
9040     if (!pcbddc->benign_change_explicit) {
9041       benign_n = pcbddc->benign_n;
9042     } else {
9043       benign_n = 0;
9044     }
9045     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9046        We need a global reduction to avoid possible deadlocks.
9047        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9048     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9049       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9050       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9051       need_change = (PetscBool)(!need_change);
9052     }
9053     /* If the user defines additional constraints, we import them here.
9054        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 */
9055     if (need_change) {
9056       PC_IS   *pcisf;
9057       PC_BDDC *pcbddcf;
9058       PC      pcf;
9059 
9060       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9061       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9062       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9063       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9064 
9065       /* hacks */
9066       pcisf                        = (PC_IS*)pcf->data;
9067       pcisf->is_B_local            = pcis->is_B_local;
9068       pcisf->vec1_N                = pcis->vec1_N;
9069       pcisf->BtoNmap               = pcis->BtoNmap;
9070       pcisf->n                     = pcis->n;
9071       pcisf->n_B                   = pcis->n_B;
9072       pcbddcf                      = (PC_BDDC*)pcf->data;
9073       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9074       pcbddcf->mat_graph           = pcbddc->mat_graph;
9075       pcbddcf->use_faces           = PETSC_TRUE;
9076       pcbddcf->use_change_of_basis = PETSC_TRUE;
9077       pcbddcf->use_change_on_faces = PETSC_TRUE;
9078       pcbddcf->use_qr_single       = PETSC_TRUE;
9079       pcbddcf->fake_change         = PETSC_TRUE;
9080 
9081       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9082       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9083       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9084       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9085       change = pcbddcf->ConstraintMatrix;
9086       pcbddcf->ConstraintMatrix = NULL;
9087 
9088       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9089       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9090       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9091       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9092       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9093       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9094       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9095       pcf->ops->destroy = NULL;
9096       pcf->ops->reset   = NULL;
9097       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9098     }
9099     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9100 
9101     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9102     if (iP) {
9103       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9104       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9105       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9106     }
9107     if (discrete_harmonic) {
9108       Mat A;
9109       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9110       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9111       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9112       ierr = PCBDDCSubSchursSetUp(sub_schurs,A,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);
9113       ierr = MatDestroy(&A);CHKERRQ(ierr);
9114     } else {
9115       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);
9116     }
9117     ierr = MatDestroy(&change);CHKERRQ(ierr);
9118     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9119   }
9120   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9121 
9122   /* free adjacency */
9123   if (free_used_adj) {
9124     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9125   }
9126   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9127   PetscFunctionReturn(0);
9128 }
9129 
9130 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9131 {
9132   PC_IS               *pcis=(PC_IS*)pc->data;
9133   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9134   PCBDDCGraph         graph;
9135   PetscErrorCode      ierr;
9136 
9137   PetscFunctionBegin;
9138   /* attach interface graph for determining subsets */
9139   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9140     IS       verticesIS,verticescomm;
9141     PetscInt vsize,*idxs;
9142 
9143     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9144     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9145     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9146     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9147     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9148     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9149     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9150     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9151     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9152     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9153     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9154   } else {
9155     graph = pcbddc->mat_graph;
9156   }
9157   /* print some info */
9158   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9159     IS       vertices;
9160     PetscInt nv,nedges,nfaces;
9161     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9162     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9163     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9164     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9165     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9166     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9167     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9168     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9169     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9170     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9171     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9172   }
9173 
9174   /* sub_schurs init */
9175   if (!pcbddc->sub_schurs) {
9176     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9177   }
9178   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
9179 
9180   /* free graph struct */
9181   if (pcbddc->sub_schurs_rebuild) {
9182     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9183   }
9184   PetscFunctionReturn(0);
9185 }
9186 
9187 PetscErrorCode PCBDDCCheckOperator(PC pc)
9188 {
9189   PC_IS               *pcis=(PC_IS*)pc->data;
9190   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9191   PetscErrorCode      ierr;
9192 
9193   PetscFunctionBegin;
9194   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9195     IS             zerodiag = NULL;
9196     Mat            S_j,B0_B=NULL;
9197     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9198     PetscScalar    *p0_check,*array,*array2;
9199     PetscReal      norm;
9200     PetscInt       i;
9201 
9202     /* B0 and B0_B */
9203     if (zerodiag) {
9204       IS       dummy;
9205 
9206       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9207       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9208       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9209       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9210     }
9211     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9212     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9213     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9214     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9215     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9216     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9217     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9218     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9219     /* S_j */
9220     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9221     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9222 
9223     /* mimic vector in \widetilde{W}_\Gamma */
9224     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9225     /* continuous in primal space */
9226     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9227     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9228     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9229     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9230     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9231     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9232     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9233     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9234     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9235     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9236     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9237     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9238     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9239     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9240 
9241     /* assemble rhs for coarse problem */
9242     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9243     /* local with Schur */
9244     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9245     if (zerodiag) {
9246       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9247       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9248       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9249       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9250     }
9251     /* sum on primal nodes the local contributions */
9252     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9253     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9254     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9255     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9256     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9257     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9258     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9259     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9260     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9261     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9262     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9263     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9264     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9265     /* scale primal nodes (BDDC sums contibutions) */
9266     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9267     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9268     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9269     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9270     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9271     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9272     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9273     /* global: \widetilde{B0}_B w_\Gamma */
9274     if (zerodiag) {
9275       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9276       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9277       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9278       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9279     }
9280     /* BDDC */
9281     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9282     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9283 
9284     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9285     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9286     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9287     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9288     for (i=0;i<pcbddc->benign_n;i++) {
9289       ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%D] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));CHKERRQ(ierr);
9290     }
9291     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9292     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9293     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9294     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9295     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9296     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9297   }
9298   PetscFunctionReturn(0);
9299 }
9300 
9301 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9302 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9303 {
9304   Mat            At;
9305   IS             rows;
9306   PetscInt       rst,ren;
9307   PetscErrorCode ierr;
9308   PetscLayout    rmap;
9309 
9310   PetscFunctionBegin;
9311   rst = ren = 0;
9312   if (ccomm != MPI_COMM_NULL) {
9313     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9314     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9315     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9316     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9317     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9318   }
9319   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9320   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9321   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9322 
9323   if (ccomm != MPI_COMM_NULL) {
9324     Mat_MPIAIJ *a,*b;
9325     IS         from,to;
9326     Vec        gvec;
9327     PetscInt   lsize;
9328 
9329     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9330     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9331     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9332     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9333     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9334     a    = (Mat_MPIAIJ*)At->data;
9335     b    = (Mat_MPIAIJ*)(*B)->data;
9336     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9337     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9338     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9339     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9340     b->A = a->A;
9341     b->B = a->B;
9342 
9343     b->donotstash      = a->donotstash;
9344     b->roworiented     = a->roworiented;
9345     b->rowindices      = 0;
9346     b->rowvalues       = 0;
9347     b->getrowactive    = PETSC_FALSE;
9348 
9349     (*B)->rmap         = rmap;
9350     (*B)->factortype   = A->factortype;
9351     (*B)->assembled    = PETSC_TRUE;
9352     (*B)->insertmode   = NOT_SET_VALUES;
9353     (*B)->preallocated = PETSC_TRUE;
9354 
9355     if (a->colmap) {
9356 #if defined(PETSC_USE_CTABLE)
9357       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9358 #else
9359       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9360       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9361       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9362 #endif
9363     } else b->colmap = 0;
9364     if (a->garray) {
9365       PetscInt len;
9366       len  = a->B->cmap->n;
9367       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9368       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9369       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9370     } else b->garray = 0;
9371 
9372     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9373     b->lvec = a->lvec;
9374     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9375 
9376     /* cannot use VecScatterCopy */
9377     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9378     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9379     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9380     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9381     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9382     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9383     ierr = ISDestroy(&from);CHKERRQ(ierr);
9384     ierr = ISDestroy(&to);CHKERRQ(ierr);
9385     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9386   }
9387   ierr = MatDestroy(&At);CHKERRQ(ierr);
9388   PetscFunctionReturn(0);
9389 }
9390