xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision e5afcf2835ad2df3c79a70d4d9a0fbb86e97247e)
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 = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));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 = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));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 = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));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 = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));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 = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
638   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));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 = PetscMemzero(marks,ne*sizeof(PetscInt));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 = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));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 = PetscMemzero(marks,ne*sizeof(PetscInt));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 = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));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 = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));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 = PetscMemcpy(pcbddc->mat_graph->coords,coords,cdim*n*dof*sizeof(PetscReal));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 = DMGetSection(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 = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1867   }
1868   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));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 = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));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, 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           }
2393           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2394         }
2395         cids[i+1] = cum;
2396         /* mark dofs as already assigned */
2397         for (j = cids[i]; j < cids[i+1]; j++) {
2398           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2399         }
2400       }
2401       if (cc) {
2402         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2403         for (i = 0; i < graph->ncc; i++) {
2404           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2405         }
2406         *cc = cc_n;
2407       }
2408       if (primalv) {
2409         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2410       }
2411       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2412       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2413       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2414     }
2415   } else {
2416     if (ncc) *ncc = graph->ncc;
2417     if (cc) {
2418       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2419       for (i=0;i<graph->ncc;i++) {
2420         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);
2421       }
2422       *cc = cc_n;
2423     }
2424   }
2425   /* clean up graph */
2426   graph->xadj = 0;
2427   graph->adjncy = 0;
2428   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2429   PetscFunctionReturn(0);
2430 }
2431 
2432 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2433 {
2434   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2435   PC_IS*         pcis = (PC_IS*)(pc->data);
2436   IS             dirIS = NULL;
2437   PetscInt       i;
2438   PetscErrorCode ierr;
2439 
2440   PetscFunctionBegin;
2441   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2442   if (zerodiag) {
2443     Mat            A;
2444     Vec            vec3_N;
2445     PetscScalar    *vals;
2446     const PetscInt *idxs;
2447     PetscInt       nz,*count;
2448 
2449     /* p0 */
2450     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2451     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2452     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2453     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2454     for (i=0;i<nz;i++) vals[i] = 1.;
2455     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2456     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2457     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2458     /* v_I */
2459     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2460     for (i=0;i<nz;i++) vals[i] = 0.;
2461     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2462     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2463     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2464     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2465     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2466     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2467     if (dirIS) {
2468       PetscInt n;
2469 
2470       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2471       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2472       for (i=0;i<n;i++) vals[i] = 0.;
2473       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2474       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2475     }
2476     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2477     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2478     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2479     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2480     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2481     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2482     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2483     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]));
2484     ierr = PetscFree(vals);CHKERRQ(ierr);
2485     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2486 
2487     /* there should not be any pressure dofs lying on the interface */
2488     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2489     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2490     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2491     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2492     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2493     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]);
2494     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2495     ierr = PetscFree(count);CHKERRQ(ierr);
2496   }
2497   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2498 
2499   /* check PCBDDCBenignGetOrSetP0 */
2500   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2501   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2502   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2503   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2504   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2505   for (i=0;i<pcbddc->benign_n;i++) {
2506     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2507     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);
2508   }
2509   PetscFunctionReturn(0);
2510 }
2511 
2512 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2513 {
2514   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2515   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2516   PetscInt       nz,n,benign_n,bsp = 1;
2517   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2518   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2519   PetscErrorCode ierr;
2520 
2521   PetscFunctionBegin;
2522   if (reuse) goto project_b0;
2523   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2524   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2525   for (n=0;n<pcbddc->benign_n;n++) {
2526     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2527   }
2528   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2529   has_null_pressures = PETSC_TRUE;
2530   have_null = PETSC_TRUE;
2531   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2532      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2533      Checks if all the pressure dofs in each subdomain have a zero diagonal
2534      If not, a change of basis on pressures is not needed
2535      since the local Schur complements are already SPD
2536   */
2537   if (pcbddc->n_ISForDofsLocal) {
2538     IS        iP = NULL;
2539     PetscInt  p,*pp;
2540     PetscBool flg;
2541 
2542     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2543     n    = pcbddc->n_ISForDofsLocal;
2544     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2545     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2546     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2547     if (!flg) {
2548       n = 1;
2549       pp[0] = pcbddc->n_ISForDofsLocal-1;
2550     }
2551 
2552     bsp = 0;
2553     for (p=0;p<n;p++) {
2554       PetscInt bs;
2555 
2556       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]);
2557       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2558       bsp += bs;
2559     }
2560     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2561     bsp  = 0;
2562     for (p=0;p<n;p++) {
2563       const PetscInt *idxs;
2564       PetscInt       b,bs,npl,*bidxs;
2565 
2566       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2567       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2568       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2569       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2570       for (b=0;b<bs;b++) {
2571         PetscInt i;
2572 
2573         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2574         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2575         bsp++;
2576       }
2577       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2578       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2579     }
2580     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2581 
2582     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2583     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2584     if (iP) {
2585       IS newpressures;
2586 
2587       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2588       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2589       pressures = newpressures;
2590     }
2591     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2592     if (!sorted) {
2593       ierr = ISSort(pressures);CHKERRQ(ierr);
2594     }
2595     ierr = PetscFree(pp);CHKERRQ(ierr);
2596   }
2597 
2598   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2599   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2600   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2601   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2602   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2603   if (!sorted) {
2604     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2605   }
2606   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2607   zerodiag_save = zerodiag;
2608   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2609   if (!nz) {
2610     if (n) have_null = PETSC_FALSE;
2611     has_null_pressures = PETSC_FALSE;
2612     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2613   }
2614   recompute_zerodiag = PETSC_FALSE;
2615 
2616   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2617   zerodiag_subs    = NULL;
2618   benign_n         = 0;
2619   n_interior_dofs  = 0;
2620   interior_dofs    = NULL;
2621   nneu             = 0;
2622   if (pcbddc->NeumannBoundariesLocal) {
2623     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2624   }
2625   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2626   if (checkb) { /* need to compute interior nodes */
2627     PetscInt n,i,j;
2628     PetscInt n_neigh,*neigh,*n_shared,**shared;
2629     PetscInt *iwork;
2630 
2631     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2632     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2633     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2634     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2635     for (i=1;i<n_neigh;i++)
2636       for (j=0;j<n_shared[i];j++)
2637           iwork[shared[i][j]] += 1;
2638     for (i=0;i<n;i++)
2639       if (!iwork[i])
2640         interior_dofs[n_interior_dofs++] = i;
2641     ierr = PetscFree(iwork);CHKERRQ(ierr);
2642     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2643   }
2644   if (has_null_pressures) {
2645     IS             *subs;
2646     PetscInt       nsubs,i,j,nl;
2647     const PetscInt *idxs;
2648     PetscScalar    *array;
2649     Vec            *work;
2650     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2651 
2652     subs  = pcbddc->local_subs;
2653     nsubs = pcbddc->n_local_subs;
2654     /* 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) */
2655     if (checkb) {
2656       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2657       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2658       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2659       /* work[0] = 1_p */
2660       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2661       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2662       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2663       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2664       /* work[0] = 1_v */
2665       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2666       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2667       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2668       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2669       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2670     }
2671 
2672     if (nsubs > 1 || bsp > 1) {
2673       IS       *is;
2674       PetscInt b,totb;
2675 
2676       totb  = bsp;
2677       is    = bsp > 1 ? bzerodiag : &zerodiag;
2678       nsubs = PetscMax(nsubs,1);
2679       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2680       for (b=0;b<totb;b++) {
2681         for (i=0;i<nsubs;i++) {
2682           ISLocalToGlobalMapping l2g;
2683           IS                     t_zerodiag_subs;
2684           PetscInt               nl;
2685 
2686           if (subs) {
2687             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2688           } else {
2689             IS tis;
2690 
2691             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2692             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2693             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2694             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2695           }
2696           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2697           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2698           if (nl) {
2699             PetscBool valid = PETSC_TRUE;
2700 
2701             if (checkb) {
2702               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2703               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2704               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2705               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2706               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2707               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2708               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2709               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2710               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2711               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2712               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2713               for (j=0;j<n_interior_dofs;j++) {
2714                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2715                   valid = PETSC_FALSE;
2716                   break;
2717                 }
2718               }
2719               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2720             }
2721             if (valid && nneu) {
2722               const PetscInt *idxs;
2723               PetscInt       nzb;
2724 
2725               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2726               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2727               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2728               if (nzb) valid = PETSC_FALSE;
2729             }
2730             if (valid && pressures) {
2731               IS       t_pressure_subs,tmp;
2732               PetscInt i1,i2;
2733 
2734               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2735               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2736               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2737               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2738               if (i2 != i1) valid = PETSC_FALSE;
2739               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2740               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2741             }
2742             if (valid) {
2743               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2744               benign_n++;
2745             } else recompute_zerodiag = PETSC_TRUE;
2746           }
2747           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2748           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2749         }
2750       }
2751     } else { /* there's just one subdomain (or zero if they have not been detected */
2752       PetscBool valid = PETSC_TRUE;
2753 
2754       if (nneu) valid = PETSC_FALSE;
2755       if (valid && pressures) {
2756         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2757       }
2758       if (valid && checkb) {
2759         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2760         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2761         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2762         for (j=0;j<n_interior_dofs;j++) {
2763           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2764             valid = PETSC_FALSE;
2765             break;
2766           }
2767         }
2768         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2769       }
2770       if (valid) {
2771         benign_n = 1;
2772         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2773         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2774         zerodiag_subs[0] = zerodiag;
2775       }
2776     }
2777     if (checkb) {
2778       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2779     }
2780   }
2781   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2782 
2783   if (!benign_n) {
2784     PetscInt n;
2785 
2786     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2787     recompute_zerodiag = PETSC_FALSE;
2788     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2789     if (n) have_null = PETSC_FALSE;
2790   }
2791 
2792   /* final check for null pressures */
2793   if (zerodiag && pressures) {
2794     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2795   }
2796 
2797   if (recompute_zerodiag) {
2798     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2799     if (benign_n == 1) {
2800       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2801       zerodiag = zerodiag_subs[0];
2802     } else {
2803       PetscInt i,nzn,*new_idxs;
2804 
2805       nzn = 0;
2806       for (i=0;i<benign_n;i++) {
2807         PetscInt ns;
2808         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2809         nzn += ns;
2810       }
2811       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2812       nzn = 0;
2813       for (i=0;i<benign_n;i++) {
2814         PetscInt ns,*idxs;
2815         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2816         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2817         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2818         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2819         nzn += ns;
2820       }
2821       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2822       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2823     }
2824     have_null = PETSC_FALSE;
2825   }
2826 
2827   /* determines if the coarse solver will be singular or not */
2828   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2829 
2830   /* Prepare matrix to compute no-net-flux */
2831   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2832     Mat                    A,loc_divudotp;
2833     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2834     IS                     row,col,isused = NULL;
2835     PetscInt               M,N,n,st,n_isused;
2836 
2837     if (pressures) {
2838       isused = pressures;
2839     } else {
2840       isused = zerodiag_save;
2841     }
2842     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2843     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2844     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2845     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");
2846     n_isused = 0;
2847     if (isused) {
2848       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2849     }
2850     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2851     st = st-n_isused;
2852     if (n) {
2853       const PetscInt *gidxs;
2854 
2855       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2856       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2857       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2858       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2859       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2860       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2861     } else {
2862       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2863       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2864       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2865     }
2866     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2867     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2868     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2869     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2870     ierr = ISDestroy(&row);CHKERRQ(ierr);
2871     ierr = ISDestroy(&col);CHKERRQ(ierr);
2872     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2873     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2874     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2875     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2876     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2877     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2878     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2879     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2880     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2881     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2882   }
2883   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2884   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2885   if (bzerodiag) {
2886     PetscInt i;
2887 
2888     for (i=0;i<bsp;i++) {
2889       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2890     }
2891     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2892   }
2893   pcbddc->benign_n = benign_n;
2894   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2895 
2896   /* determines if the problem has subdomains with 0 pressure block */
2897   have_null = (PetscBool)(!!pcbddc->benign_n);
2898   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2899 
2900 project_b0:
2901   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2902   /* change of basis and p0 dofs */
2903   if (pcbddc->benign_n) {
2904     PetscInt i,s,*nnz;
2905 
2906     /* local change of basis for pressures */
2907     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2908     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2909     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2910     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2911     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2912     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2913     for (i=0;i<pcbddc->benign_n;i++) {
2914       const PetscInt *idxs;
2915       PetscInt       nzs,j;
2916 
2917       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2918       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2919       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2920       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2921       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2922     }
2923     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2924     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2925     ierr = PetscFree(nnz);CHKERRQ(ierr);
2926     /* set identity by default */
2927     for (i=0;i<n;i++) {
2928       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2929     }
2930     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2931     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2932     /* set change on pressures */
2933     for (s=0;s<pcbddc->benign_n;s++) {
2934       PetscScalar    *array;
2935       const PetscInt *idxs;
2936       PetscInt       nzs;
2937 
2938       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2939       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2940       for (i=0;i<nzs-1;i++) {
2941         PetscScalar vals[2];
2942         PetscInt    cols[2];
2943 
2944         cols[0] = idxs[i];
2945         cols[1] = idxs[nzs-1];
2946         vals[0] = 1.;
2947         vals[1] = 1.;
2948         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2949       }
2950       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2951       for (i=0;i<nzs-1;i++) array[i] = -1.;
2952       array[nzs-1] = 1.;
2953       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2954       /* store local idxs for p0 */
2955       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2956       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2957       ierr = PetscFree(array);CHKERRQ(ierr);
2958     }
2959     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2960     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2961 
2962     /* project if needed */
2963     if (pcbddc->benign_change_explicit) {
2964       Mat M;
2965 
2966       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2967       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2968       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2969       ierr = MatDestroy(&M);CHKERRQ(ierr);
2970     }
2971     /* store global idxs for p0 */
2972     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2973   }
2974   *zerodiaglocal = zerodiag;
2975   PetscFunctionReturn(0);
2976 }
2977 
2978 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2979 {
2980   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2981   PetscScalar    *array;
2982   PetscErrorCode ierr;
2983 
2984   PetscFunctionBegin;
2985   if (!pcbddc->benign_sf) {
2986     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2987     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2988   }
2989   if (get) {
2990     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2991     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2992     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2993     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2994   } else {
2995     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2996     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2997     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2998     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2999   }
3000   PetscFunctionReturn(0);
3001 }
3002 
3003 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3004 {
3005   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3006   PetscErrorCode ierr;
3007 
3008   PetscFunctionBegin;
3009   /* TODO: add error checking
3010     - avoid nested pop (or push) calls.
3011     - cannot push before pop.
3012     - cannot call this if pcbddc->local_mat is NULL
3013   */
3014   if (!pcbddc->benign_n) {
3015     PetscFunctionReturn(0);
3016   }
3017   if (pop) {
3018     if (pcbddc->benign_change_explicit) {
3019       IS       is_p0;
3020       MatReuse reuse;
3021 
3022       /* extract B_0 */
3023       reuse = MAT_INITIAL_MATRIX;
3024       if (pcbddc->benign_B0) {
3025         reuse = MAT_REUSE_MATRIX;
3026       }
3027       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3028       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3029       /* remove rows and cols from local problem */
3030       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3031       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3032       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3033       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3034     } else {
3035       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3036       PetscScalar *vals;
3037       PetscInt    i,n,*idxs_ins;
3038 
3039       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3040       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3041       if (!pcbddc->benign_B0) {
3042         PetscInt *nnz;
3043         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3044         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3045         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3046         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3047         for (i=0;i<pcbddc->benign_n;i++) {
3048           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3049           nnz[i] = n - nnz[i];
3050         }
3051         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3052         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3053         ierr = PetscFree(nnz);CHKERRQ(ierr);
3054       }
3055 
3056       for (i=0;i<pcbddc->benign_n;i++) {
3057         PetscScalar *array;
3058         PetscInt    *idxs,j,nz,cum;
3059 
3060         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3061         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3062         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3063         for (j=0;j<nz;j++) vals[j] = 1.;
3064         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3065         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3066         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3067         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3068         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3069         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3070         cum = 0;
3071         for (j=0;j<n;j++) {
3072           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3073             vals[cum] = array[j];
3074             idxs_ins[cum] = j;
3075             cum++;
3076           }
3077         }
3078         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3079         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3080         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3081       }
3082       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3083       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3084       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3085     }
3086   } else { /* push */
3087     if (pcbddc->benign_change_explicit) {
3088       PetscInt i;
3089 
3090       for (i=0;i<pcbddc->benign_n;i++) {
3091         PetscScalar *B0_vals;
3092         PetscInt    *B0_cols,B0_ncol;
3093 
3094         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3095         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3096         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3097         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3098         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3099       }
3100       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3101       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3102     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3103   }
3104   PetscFunctionReturn(0);
3105 }
3106 
3107 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3108 {
3109   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3110   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3111   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3112   PetscBLASInt    *B_iwork,*B_ifail;
3113   PetscScalar     *work,lwork;
3114   PetscScalar     *St,*S,*eigv;
3115   PetscScalar     *Sarray,*Starray;
3116   PetscReal       *eigs,thresh,lthresh,uthresh;
3117   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3118   PetscBool       allocated_S_St;
3119 #if defined(PETSC_USE_COMPLEX)
3120   PetscReal       *rwork;
3121 #endif
3122   PetscErrorCode  ierr;
3123 
3124   PetscFunctionBegin;
3125   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3126   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3127   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);
3128   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3129 
3130   if (pcbddc->dbg_flag) {
3131     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3132     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3133     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3134     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3135   }
3136 
3137   if (pcbddc->dbg_flag) {
3138     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);
3139   }
3140 
3141   /* max size of subsets */
3142   mss = 0;
3143   for (i=0;i<sub_schurs->n_subs;i++) {
3144     PetscInt subset_size;
3145 
3146     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3147     mss = PetscMax(mss,subset_size);
3148   }
3149 
3150   /* min/max and threshold */
3151   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3152   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3153   nmax = PetscMax(nmin,nmax);
3154   allocated_S_St = PETSC_FALSE;
3155   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3156     allocated_S_St = PETSC_TRUE;
3157   }
3158 
3159   /* allocate lapack workspace */
3160   cum = cum2 = 0;
3161   maxneigs = 0;
3162   for (i=0;i<sub_schurs->n_subs;i++) {
3163     PetscInt n,subset_size;
3164 
3165     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3166     n = PetscMin(subset_size,nmax);
3167     cum += subset_size;
3168     cum2 += subset_size*n;
3169     maxneigs = PetscMax(maxneigs,n);
3170   }
3171   if (mss) {
3172     if (sub_schurs->is_symmetric) {
3173       PetscBLASInt B_itype = 1;
3174       PetscBLASInt B_N = mss;
3175       PetscReal    zero = 0.0;
3176       PetscReal    eps = 0.0; /* dlamch? */
3177 
3178       B_lwork = -1;
3179       S = NULL;
3180       St = NULL;
3181       eigs = NULL;
3182       eigv = NULL;
3183       B_iwork = NULL;
3184       B_ifail = NULL;
3185 #if defined(PETSC_USE_COMPLEX)
3186       rwork = NULL;
3187 #endif
3188       thresh = 1.0;
3189       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3190 #if defined(PETSC_USE_COMPLEX)
3191       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));
3192 #else
3193       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));
3194 #endif
3195       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3196       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3197     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3198   } else {
3199     lwork = 0;
3200   }
3201 
3202   nv = 0;
3203   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) */
3204     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3205   }
3206   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3207   if (allocated_S_St) {
3208     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3209   }
3210   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3211 #if defined(PETSC_USE_COMPLEX)
3212   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3213 #endif
3214   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3215                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3216                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3217                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3218                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3219   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3220 
3221   maxneigs = 0;
3222   cum = cumarray = 0;
3223   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3224   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3225   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3226     const PetscInt *idxs;
3227 
3228     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3229     for (cum=0;cum<nv;cum++) {
3230       pcbddc->adaptive_constraints_n[cum] = 1;
3231       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3232       pcbddc->adaptive_constraints_data[cum] = 1.0;
3233       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3234       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3235     }
3236     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3237   }
3238 
3239   if (mss) { /* multilevel */
3240     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3241     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3242   }
3243 
3244   lthresh = pcbddc->adaptive_threshold[0];
3245   uthresh = pcbddc->adaptive_threshold[1];
3246   for (i=0;i<sub_schurs->n_subs;i++) {
3247     const PetscInt *idxs;
3248     PetscReal      upper,lower;
3249     PetscInt       j,subset_size,eigs_start = 0;
3250     PetscBLASInt   B_N;
3251     PetscBool      same_data = PETSC_FALSE;
3252     PetscBool      scal = PETSC_FALSE;
3253 
3254     if (pcbddc->use_deluxe_scaling) {
3255       upper = PETSC_MAX_REAL;
3256       lower = uthresh;
3257     } else {
3258       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3259       upper = 1./uthresh;
3260       lower = 0.;
3261     }
3262     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3263     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3264     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3265     /* this is experimental: we assume the dofs have been properly grouped to have
3266        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3267     if (!sub_schurs->is_posdef) {
3268       Mat T;
3269 
3270       for (j=0;j<subset_size;j++) {
3271         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3272           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3273           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3274           ierr = MatDestroy(&T);CHKERRQ(ierr);
3275           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3276           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3277           ierr = MatDestroy(&T);CHKERRQ(ierr);
3278           if (sub_schurs->change_primal_sub) {
3279             PetscInt       nz,k;
3280             const PetscInt *idxs;
3281 
3282             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3283             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3284             for (k=0;k<nz;k++) {
3285               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3286               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3287             }
3288             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3289           }
3290           scal = PETSC_TRUE;
3291           break;
3292         }
3293       }
3294     }
3295 
3296     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3297       if (sub_schurs->is_symmetric) {
3298         PetscInt j,k;
3299         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3300           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3301           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3302         }
3303         for (j=0;j<subset_size;j++) {
3304           for (k=j;k<subset_size;k++) {
3305             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3306             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3307           }
3308         }
3309       } else {
3310         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3311         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3312       }
3313     } else {
3314       S = Sarray + cumarray;
3315       St = Starray + cumarray;
3316     }
3317     /* see if we can save some work */
3318     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3319       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3320     }
3321 
3322     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3323       B_neigs = 0;
3324     } else {
3325       if (sub_schurs->is_symmetric) {
3326         PetscBLASInt B_itype = 1;
3327         PetscBLASInt B_IL, B_IU;
3328         PetscReal    eps = -1.0; /* dlamch? */
3329         PetscInt     nmin_s;
3330         PetscBool    compute_range;
3331 
3332         B_neigs = 0;
3333         compute_range = (PetscBool)!same_data;
3334         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3335 
3336         if (pcbddc->dbg_flag) {
3337           PetscInt nc = 0;
3338 
3339           if (sub_schurs->change_primal_sub) {
3340             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3341           }
3342           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);
3343         }
3344 
3345         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3346         if (compute_range) {
3347 
3348           /* ask for eigenvalues larger than thresh */
3349           if (sub_schurs->is_posdef) {
3350 #if defined(PETSC_USE_COMPLEX)
3351             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));
3352 #else
3353             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));
3354 #endif
3355             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3356           } else { /* no theory so far, but it works nicely */
3357             PetscInt  recipe = 0,recipe_m = 1;
3358             PetscReal bb[2];
3359 
3360             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3361             switch (recipe) {
3362             case 0:
3363               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3364               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3365 #if defined(PETSC_USE_COMPLEX)
3366               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));
3367 #else
3368               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));
3369 #endif
3370               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3371               break;
3372             case 1:
3373               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3374 #if defined(PETSC_USE_COMPLEX)
3375               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));
3376 #else
3377               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));
3378 #endif
3379               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3380               if (!scal) {
3381                 PetscBLASInt B_neigs2 = 0;
3382 
3383                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3384                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3385                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3386 #if defined(PETSC_USE_COMPLEX)
3387                 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));
3388 #else
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_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3390 #endif
3391                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3392                 B_neigs += B_neigs2;
3393               }
3394               break;
3395             case 2:
3396               if (scal) {
3397                 bb[0] = PETSC_MIN_REAL;
3398                 bb[1] = 0;
3399 #if defined(PETSC_USE_COMPLEX)
3400                 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));
3401 #else
3402                 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));
3403 #endif
3404                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3405               } else {
3406                 PetscBLASInt B_neigs2 = 0;
3407                 PetscBool    import = PETSC_FALSE;
3408 
3409                 lthresh = PetscMax(lthresh,0.0);
3410                 if (lthresh > 0.0) {
3411                   bb[0] = PETSC_MIN_REAL;
3412                   bb[1] = lthresh*lthresh;
3413 
3414                   import = PETSC_TRUE;
3415 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3417 #else
3418                   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));
3419 #endif
3420                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3421                 }
3422                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3423                 bb[1] = PETSC_MAX_REAL;
3424                 if (import) {
3425                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3426                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3427                 }
3428 #if defined(PETSC_USE_COMPLEX)
3429                 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));
3430 #else
3431                 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));
3432 #endif
3433                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3434                 B_neigs += B_neigs2;
3435               }
3436               break;
3437             case 3:
3438               if (scal) {
3439                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3440               } else {
3441                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3442               }
3443               if (!scal) {
3444                 bb[0] = uthresh;
3445                 bb[1] = PETSC_MAX_REAL;
3446 #if defined(PETSC_USE_COMPLEX)
3447                 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));
3448 #else
3449                 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));
3450 #endif
3451                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3452               }
3453               if (recipe_m > 0 && B_N - B_neigs > 0) {
3454                 PetscBLASInt B_neigs2 = 0;
3455 
3456                 B_IL = 1;
3457                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3458                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3459                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3460 #if defined(PETSC_USE_COMPLEX)
3461                 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));
3462 #else
3463                 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));
3464 #endif
3465                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3466                 B_neigs += B_neigs2;
3467               }
3468               break;
3469             case 4:
3470               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3471 #if defined(PETSC_USE_COMPLEX)
3472               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));
3473 #else
3474               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));
3475 #endif
3476               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3477               {
3478                 PetscBLASInt B_neigs2 = 0;
3479 
3480                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3481                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3482                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3483 #if defined(PETSC_USE_COMPLEX)
3484                 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));
3485 #else
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_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3487 #endif
3488                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3489                 B_neigs += B_neigs2;
3490               }
3491               break;
3492             case 5: /* same as before: first compute all eigenvalues, then filter */
3493 #if defined(PETSC_USE_COMPLEX)
3494               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));
3495 #else
3496               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));
3497 #endif
3498               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3499               {
3500                 PetscInt e,k,ne;
3501                 for (e=0,ne=0;e<B_neigs;e++) {
3502                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3503                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3504                     eigs[ne] = eigs[e];
3505                     ne++;
3506                   }
3507                 }
3508                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3509                 B_neigs = ne;
3510               }
3511               break;
3512             default:
3513               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3514               break;
3515             }
3516           }
3517         } else if (!same_data) { /* this is just to see all the eigenvalues */
3518           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3519           B_IL = 1;
3520 #if defined(PETSC_USE_COMPLEX)
3521           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));
3522 #else
3523           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));
3524 #endif
3525           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3526         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3527           PetscInt k;
3528           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3529           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3530           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3531           nmin = nmax;
3532           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3533           for (k=0;k<nmax;k++) {
3534             eigs[k] = 1./PETSC_SMALL;
3535             eigv[k*(subset_size+1)] = 1.0;
3536           }
3537         }
3538         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3539         if (B_ierr) {
3540           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3541           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);
3542           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);
3543         }
3544 
3545         if (B_neigs > nmax) {
3546           if (pcbddc->dbg_flag) {
3547             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3548           }
3549           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3550           B_neigs = nmax;
3551         }
3552 
3553         nmin_s = PetscMin(nmin,B_N);
3554         if (B_neigs < nmin_s) {
3555           PetscBLASInt B_neigs2 = 0;
3556 
3557           if (pcbddc->use_deluxe_scaling) {
3558             if (scal) {
3559               B_IU = nmin_s;
3560               B_IL = B_neigs + 1;
3561             } else {
3562               B_IL = B_N - nmin_s + 1;
3563               B_IU = B_N - B_neigs;
3564             }
3565           } else {
3566             B_IL = B_neigs + 1;
3567             B_IU = nmin_s;
3568           }
3569           if (pcbddc->dbg_flag) {
3570             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);
3571           }
3572           if (sub_schurs->is_symmetric) {
3573             PetscInt j,k;
3574             for (j=0;j<subset_size;j++) {
3575               for (k=j;k<subset_size;k++) {
3576                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3577                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3578               }
3579             }
3580           } else {
3581             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3582             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3583           }
3584           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3585 #if defined(PETSC_USE_COMPLEX)
3586           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));
3587 #else
3588           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));
3589 #endif
3590           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3591           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3592           B_neigs += B_neigs2;
3593         }
3594         if (B_ierr) {
3595           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3596           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);
3597           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);
3598         }
3599         if (pcbddc->dbg_flag) {
3600           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3601           for (j=0;j<B_neigs;j++) {
3602             if (eigs[j] == 0.0) {
3603               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3604             } else {
3605               if (pcbddc->use_deluxe_scaling) {
3606                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3607               } else {
3608                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3609               }
3610             }
3611           }
3612         }
3613       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3614     }
3615     /* change the basis back to the original one */
3616     if (sub_schurs->change) {
3617       Mat change,phi,phit;
3618 
3619       if (pcbddc->dbg_flag > 2) {
3620         PetscInt ii;
3621         for (ii=0;ii<B_neigs;ii++) {
3622           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3623           for (j=0;j<B_N;j++) {
3624 #if defined(PETSC_USE_COMPLEX)
3625             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3626             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3627             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3628 #else
3629             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3630 #endif
3631           }
3632         }
3633       }
3634       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3635       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3636       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3637       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3638       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3639       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3640     }
3641     maxneigs = PetscMax(B_neigs,maxneigs);
3642     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3643     if (B_neigs) {
3644       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3645 
3646       if (pcbddc->dbg_flag > 1) {
3647         PetscInt ii;
3648         for (ii=0;ii<B_neigs;ii++) {
3649           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3650           for (j=0;j<B_N;j++) {
3651 #if defined(PETSC_USE_COMPLEX)
3652             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3653             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3654             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3655 #else
3656             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3657 #endif
3658           }
3659         }
3660       }
3661       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3662       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3663       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3664       cum++;
3665     }
3666     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3667     /* shift for next computation */
3668     cumarray += subset_size*subset_size;
3669   }
3670   if (pcbddc->dbg_flag) {
3671     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3672   }
3673 
3674   if (mss) {
3675     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3676     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3677     /* destroy matrices (junk) */
3678     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3679     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3680   }
3681   if (allocated_S_St) {
3682     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3683   }
3684   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3685 #if defined(PETSC_USE_COMPLEX)
3686   ierr = PetscFree(rwork);CHKERRQ(ierr);
3687 #endif
3688   if (pcbddc->dbg_flag) {
3689     PetscInt maxneigs_r;
3690     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3691     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3692   }
3693   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3694   PetscFunctionReturn(0);
3695 }
3696 
3697 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3698 {
3699   PetscScalar    *coarse_submat_vals;
3700   PetscErrorCode ierr;
3701 
3702   PetscFunctionBegin;
3703   /* Setup local scatters R_to_B and (optionally) R_to_D */
3704   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3705   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3706 
3707   /* Setup local neumann solver ksp_R */
3708   /* PCBDDCSetUpLocalScatters should be called first! */
3709   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3710 
3711   /*
3712      Setup local correction and local part of coarse basis.
3713      Gives back the dense local part of the coarse matrix in column major ordering
3714   */
3715   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3716 
3717   /* Compute total number of coarse nodes and setup coarse solver */
3718   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3719 
3720   /* free */
3721   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3722   PetscFunctionReturn(0);
3723 }
3724 
3725 PetscErrorCode PCBDDCResetCustomization(PC pc)
3726 {
3727   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3728   PetscErrorCode ierr;
3729 
3730   PetscFunctionBegin;
3731   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3732   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3733   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3734   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3735   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3736   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3737   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3738   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3739   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3740   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3741   PetscFunctionReturn(0);
3742 }
3743 
3744 PetscErrorCode PCBDDCResetTopography(PC pc)
3745 {
3746   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3747   PetscInt       i;
3748   PetscErrorCode ierr;
3749 
3750   PetscFunctionBegin;
3751   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3753   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3754   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3755   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3756   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3757   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3758   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3759   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3760   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3761   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3762   for (i=0;i<pcbddc->n_local_subs;i++) {
3763     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3764   }
3765   pcbddc->n_local_subs = 0;
3766   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3767   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3768   pcbddc->graphanalyzed        = PETSC_FALSE;
3769   pcbddc->recompute_topography = PETSC_TRUE;
3770   pcbddc->corner_selected      = PETSC_FALSE;
3771   PetscFunctionReturn(0);
3772 }
3773 
3774 PetscErrorCode PCBDDCResetSolvers(PC pc)
3775 {
3776   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3777   PetscErrorCode ierr;
3778 
3779   PetscFunctionBegin;
3780   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3781   if (pcbddc->coarse_phi_B) {
3782     PetscScalar *array;
3783     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3784     ierr = PetscFree(array);CHKERRQ(ierr);
3785   }
3786   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3787   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3788   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3789   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3790   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3791   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3792   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3793   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3794   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3795   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3796   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3797   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3798   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3799   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3800   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3801   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3802   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3803   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3804   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3805   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3806   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3807   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3808   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3809   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3810   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3811   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3812   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3813   if (pcbddc->benign_zerodiag_subs) {
3814     PetscInt i;
3815     for (i=0;i<pcbddc->benign_n;i++) {
3816       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3817     }
3818     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3819   }
3820   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3821   PetscFunctionReturn(0);
3822 }
3823 
3824 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3825 {
3826   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3827   PC_IS          *pcis = (PC_IS*)pc->data;
3828   VecType        impVecType;
3829   PetscInt       n_constraints,n_R,old_size;
3830   PetscErrorCode ierr;
3831 
3832   PetscFunctionBegin;
3833   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3834   n_R = pcis->n - pcbddc->n_vertices;
3835   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3836   /* local work vectors (try to avoid unneeded work)*/
3837   /* R nodes */
3838   old_size = -1;
3839   if (pcbddc->vec1_R) {
3840     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3841   }
3842   if (n_R != old_size) {
3843     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3844     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3845     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3846     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3847     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3848     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3849   }
3850   /* local primal dofs */
3851   old_size = -1;
3852   if (pcbddc->vec1_P) {
3853     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3854   }
3855   if (pcbddc->local_primal_size != old_size) {
3856     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3857     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3858     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3859     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3860   }
3861   /* local explicit constraints */
3862   old_size = -1;
3863   if (pcbddc->vec1_C) {
3864     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3865   }
3866   if (n_constraints && n_constraints != old_size) {
3867     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3868     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3869     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3870     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3871   }
3872   PetscFunctionReturn(0);
3873 }
3874 
3875 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3876 {
3877   PetscErrorCode  ierr;
3878   /* pointers to pcis and pcbddc */
3879   PC_IS*          pcis = (PC_IS*)pc->data;
3880   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3881   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3882   /* submatrices of local problem */
3883   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3884   /* submatrices of local coarse problem */
3885   Mat             S_VV,S_CV,S_VC,S_CC;
3886   /* working matrices */
3887   Mat             C_CR;
3888   /* additional working stuff */
3889   PC              pc_R;
3890   Mat             F,Brhs = NULL;
3891   Vec             dummy_vec;
3892   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3893   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3894   PetscScalar     *work;
3895   PetscInt        *idx_V_B;
3896   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3897   PetscInt        i,n_R,n_D,n_B;
3898 
3899   /* some shortcuts to scalars */
3900   PetscScalar     one=1.0,m_one=-1.0;
3901 
3902   PetscFunctionBegin;
3903   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");
3904   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3905 
3906   /* Set Non-overlapping dimensions */
3907   n_vertices = pcbddc->n_vertices;
3908   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3909   n_B = pcis->n_B;
3910   n_D = pcis->n - n_B;
3911   n_R = pcis->n - n_vertices;
3912 
3913   /* vertices in boundary numbering */
3914   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3915   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3916   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3917 
3918   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3919   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3920   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3921   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3922   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3923   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3924   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3925   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3926   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3927   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3928 
3929   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3930   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3931   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3932   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3933   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3934   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3935   lda_rhs = n_R;
3936   need_benign_correction = PETSC_FALSE;
3937   if (isLU || isILU || isCHOL) {
3938     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3939   } else if (sub_schurs && sub_schurs->reuse_solver) {
3940     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3941     MatFactorType      type;
3942 
3943     F = reuse_solver->F;
3944     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3945     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3946     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3947     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3948   } else {
3949     F = NULL;
3950   }
3951 
3952   /* determine if we can use a sparse right-hand side */
3953   sparserhs = PETSC_FALSE;
3954   if (F) {
3955     MatSolverType solver;
3956 
3957     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3958     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3959   }
3960 
3961   /* allocate workspace */
3962   n = 0;
3963   if (n_constraints) {
3964     n += lda_rhs*n_constraints;
3965   }
3966   if (n_vertices) {
3967     n = PetscMax(2*lda_rhs*n_vertices,n);
3968     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3969   }
3970   if (!pcbddc->symmetric_primal) {
3971     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3972   }
3973   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3974 
3975   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3976   dummy_vec = NULL;
3977   if (need_benign_correction && lda_rhs != n_R && F) {
3978     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3979     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3980     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3981   }
3982 
3983   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3984   if (n_constraints) {
3985     Mat         M3,C_B;
3986     IS          is_aux;
3987     PetscScalar *array,*array2;
3988 
3989     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3990     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3991 
3992     /* Extract constraints on R nodes: C_{CR}  */
3993     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3994     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3995     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3996 
3997     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3998     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3999     if (!sparserhs) {
4000       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
4001       for (i=0;i<n_constraints;i++) {
4002         const PetscScalar *row_cmat_values;
4003         const PetscInt    *row_cmat_indices;
4004         PetscInt          size_of_constraint,j;
4005 
4006         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4007         for (j=0;j<size_of_constraint;j++) {
4008           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4009         }
4010         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4011       }
4012       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4013     } else {
4014       Mat tC_CR;
4015 
4016       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4017       if (lda_rhs != n_R) {
4018         PetscScalar *aa;
4019         PetscInt    r,*ii,*jj;
4020         PetscBool   done;
4021 
4022         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4023         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4024         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4025         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4026         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4027         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4028       } else {
4029         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4030         tC_CR = C_CR;
4031       }
4032       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4033       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4034     }
4035     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4036     if (F) {
4037       if (need_benign_correction) {
4038         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4039 
4040         /* rhs is already zero on interior dofs, no need to change the rhs */
4041         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
4042       }
4043       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4044       if (need_benign_correction) {
4045         PetscScalar        *marr;
4046         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4047 
4048         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4049         if (lda_rhs != n_R) {
4050           for (i=0;i<n_constraints;i++) {
4051             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4052             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4053             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4054           }
4055         } else {
4056           for (i=0;i<n_constraints;i++) {
4057             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4058             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4059             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4060           }
4061         }
4062         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4063       }
4064     } else {
4065       PetscScalar *marr;
4066 
4067       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4068       for (i=0;i<n_constraints;i++) {
4069         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4070         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4071         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4072         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4073         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4074         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4075       }
4076       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4077     }
4078     if (sparserhs) {
4079       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4080     }
4081     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4082     if (!pcbddc->switch_static) {
4083       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4084       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4085       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4086       for (i=0;i<n_constraints;i++) {
4087         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4088         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4089         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4090         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4091         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4092         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4093       }
4094       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4095       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4096       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4097     } else {
4098       if (lda_rhs != n_R) {
4099         IS dummy;
4100 
4101         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4102         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4103         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4104       } else {
4105         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4106         pcbddc->local_auxmat2 = local_auxmat2_R;
4107       }
4108       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4109     }
4110     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4111     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4112     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4113     if (isCHOL) {
4114       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4115     } else {
4116       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4117     }
4118     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4119     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4120     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4121     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4122     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4123     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4124   }
4125 
4126   /* Get submatrices from subdomain matrix */
4127   if (n_vertices) {
4128     IS        is_aux;
4129     PetscBool isseqaij;
4130 
4131     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4132       IS tis;
4133 
4134       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4135       ierr = ISSort(tis);CHKERRQ(ierr);
4136       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4137       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4138     } else {
4139       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4140     }
4141     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4142     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4143     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4144     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4145       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4146     }
4147     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4148     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4149   }
4150 
4151   /* Matrix of coarse basis functions (local) */
4152   if (pcbddc->coarse_phi_B) {
4153     PetscInt on_B,on_primal,on_D=n_D;
4154     if (pcbddc->coarse_phi_D) {
4155       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4156     }
4157     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4158     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4159       PetscScalar *marray;
4160 
4161       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4162       ierr = PetscFree(marray);CHKERRQ(ierr);
4163       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4164       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4165       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4166       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4167     }
4168   }
4169 
4170   if (!pcbddc->coarse_phi_B) {
4171     PetscScalar *marr;
4172 
4173     /* memory size */
4174     n = n_B*pcbddc->local_primal_size;
4175     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4176     if (!pcbddc->symmetric_primal) n *= 2;
4177     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4178     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4179     marr += n_B*pcbddc->local_primal_size;
4180     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4181       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4182       marr += n_D*pcbddc->local_primal_size;
4183     }
4184     if (!pcbddc->symmetric_primal) {
4185       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4186       marr += n_B*pcbddc->local_primal_size;
4187       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4188         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4189       }
4190     } else {
4191       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4192       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4193       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4194         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4195         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4196       }
4197     }
4198   }
4199 
4200   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4201   p0_lidx_I = NULL;
4202   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4203     const PetscInt *idxs;
4204 
4205     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4206     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4207     for (i=0;i<pcbddc->benign_n;i++) {
4208       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4209     }
4210     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4211   }
4212 
4213   /* vertices */
4214   if (n_vertices) {
4215     PetscBool restoreavr = PETSC_FALSE;
4216 
4217     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4218 
4219     if (n_R) {
4220       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4221       PetscBLASInt      B_N,B_one = 1;
4222       const PetscScalar *x;
4223       PetscScalar       *y;
4224 
4225       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4226       if (need_benign_correction) {
4227         ISLocalToGlobalMapping RtoN;
4228         IS                     is_p0;
4229         PetscInt               *idxs_p0,n;
4230 
4231         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4232         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4233         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4234         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);
4235         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4236         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4237         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4238         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4239       }
4240 
4241       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4242       if (!sparserhs || need_benign_correction) {
4243         if (lda_rhs == n_R) {
4244           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4245         } else {
4246           PetscScalar    *av,*array;
4247           const PetscInt *xadj,*adjncy;
4248           PetscInt       n;
4249           PetscBool      flg_row;
4250 
4251           array = work+lda_rhs*n_vertices;
4252           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4253           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4254           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4255           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4256           for (i=0;i<n;i++) {
4257             PetscInt j;
4258             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4259           }
4260           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4261           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4262           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4263         }
4264         if (need_benign_correction) {
4265           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4266           PetscScalar        *marr;
4267 
4268           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4269           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4270 
4271                  | 0 0  0 | (V)
4272              L = | 0 0 -1 | (P-p0)
4273                  | 0 0 -1 | (p0)
4274 
4275           */
4276           for (i=0;i<reuse_solver->benign_n;i++) {
4277             const PetscScalar *vals;
4278             const PetscInt    *idxs,*idxs_zero;
4279             PetscInt          n,j,nz;
4280 
4281             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4282             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4283             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4284             for (j=0;j<n;j++) {
4285               PetscScalar val = vals[j];
4286               PetscInt    k,col = idxs[j];
4287               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4288             }
4289             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4290             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4291           }
4292           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4293         }
4294         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4295         Brhs = A_RV;
4296       } else {
4297         Mat tA_RVT,A_RVT;
4298 
4299         if (!pcbddc->symmetric_primal) {
4300           /* A_RV already scaled by -1 */
4301           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4302         } else {
4303           restoreavr = PETSC_TRUE;
4304           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4305           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4306           A_RVT = A_VR;
4307         }
4308         if (lda_rhs != n_R) {
4309           PetscScalar *aa;
4310           PetscInt    r,*ii,*jj;
4311           PetscBool   done;
4312 
4313           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4314           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4315           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4316           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4317           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4318           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4319         } else {
4320           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4321           tA_RVT = A_RVT;
4322         }
4323         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4324         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4325         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4326       }
4327       if (F) {
4328         /* need to correct the rhs */
4329         if (need_benign_correction) {
4330           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4331           PetscScalar        *marr;
4332 
4333           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4334           if (lda_rhs != n_R) {
4335             for (i=0;i<n_vertices;i++) {
4336               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4337               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4338               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4339             }
4340           } else {
4341             for (i=0;i<n_vertices;i++) {
4342               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4343               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4344               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4345             }
4346           }
4347           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4348         }
4349         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4350         if (restoreavr) {
4351           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4352         }
4353         /* need to correct the solution */
4354         if (need_benign_correction) {
4355           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4356           PetscScalar        *marr;
4357 
4358           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4359           if (lda_rhs != n_R) {
4360             for (i=0;i<n_vertices;i++) {
4361               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4362               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4363               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4364             }
4365           } else {
4366             for (i=0;i<n_vertices;i++) {
4367               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4368               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4369               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4370             }
4371           }
4372           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4373         }
4374       } else {
4375         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4376         for (i=0;i<n_vertices;i++) {
4377           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4378           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4379           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4380           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4381           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4382           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4383         }
4384         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4385       }
4386       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4387       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4388       /* S_VV and S_CV */
4389       if (n_constraints) {
4390         Mat B;
4391 
4392         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4393         for (i=0;i<n_vertices;i++) {
4394           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4395           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4396           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4397           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4398           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4399           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4400         }
4401         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4402         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4403         ierr = MatDestroy(&B);CHKERRQ(ierr);
4404         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4405         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4406         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4407         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4408         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4409         ierr = MatDestroy(&B);CHKERRQ(ierr);
4410       }
4411       if (lda_rhs != n_R) {
4412         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4413         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4414         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4415       }
4416       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4417       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4418       if (need_benign_correction) {
4419         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4420         PetscScalar      *marr,*sums;
4421 
4422         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4423         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4424         for (i=0;i<reuse_solver->benign_n;i++) {
4425           const PetscScalar *vals;
4426           const PetscInt    *idxs,*idxs_zero;
4427           PetscInt          n,j,nz;
4428 
4429           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4430           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4431           for (j=0;j<n_vertices;j++) {
4432             PetscInt k;
4433             sums[j] = 0.;
4434             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4435           }
4436           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4437           for (j=0;j<n;j++) {
4438             PetscScalar val = vals[j];
4439             PetscInt k;
4440             for (k=0;k<n_vertices;k++) {
4441               marr[idxs[j]+k*n_vertices] += val*sums[k];
4442             }
4443           }
4444           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4445           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4446         }
4447         ierr = PetscFree(sums);CHKERRQ(ierr);
4448         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4449         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4450       }
4451       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4452       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4453       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4454       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4455       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4456       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4457       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4458       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4459       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4460     } else {
4461       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4462     }
4463     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4464 
4465     /* coarse basis functions */
4466     for (i=0;i<n_vertices;i++) {
4467       PetscScalar *y;
4468 
4469       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4470       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4471       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4472       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4473       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4474       y[n_B*i+idx_V_B[i]] = 1.0;
4475       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4476       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4477 
4478       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4479         PetscInt j;
4480 
4481         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4482         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4483         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4484         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4485         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4486         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4487         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4488       }
4489       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4490     }
4491     /* if n_R == 0 the object is not destroyed */
4492     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4493   }
4494   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4495 
4496   if (n_constraints) {
4497     Mat B;
4498 
4499     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4500     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4501     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4502     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4503     if (n_vertices) {
4504       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4505         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4506       } else {
4507         Mat S_VCt;
4508 
4509         if (lda_rhs != n_R) {
4510           ierr = MatDestroy(&B);CHKERRQ(ierr);
4511           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4512           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4513         }
4514         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4515         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4516         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4517       }
4518     }
4519     ierr = MatDestroy(&B);CHKERRQ(ierr);
4520     /* coarse basis functions */
4521     for (i=0;i<n_constraints;i++) {
4522       PetscScalar *y;
4523 
4524       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4525       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4526       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4527       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4528       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4529       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4530       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4531       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4532         PetscInt j;
4533 
4534         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4535         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4536         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4537         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4538         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4539         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4540         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4541       }
4542       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4543     }
4544   }
4545   if (n_constraints) {
4546     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4547   }
4548   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4549 
4550   /* coarse matrix entries relative to B_0 */
4551   if (pcbddc->benign_n) {
4552     Mat               B0_B,B0_BPHI;
4553     IS                is_dummy;
4554     const PetscScalar *data;
4555     PetscInt          j;
4556 
4557     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4558     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4559     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4560     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4561     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4562     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4563     for (j=0;j<pcbddc->benign_n;j++) {
4564       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4565       for (i=0;i<pcbddc->local_primal_size;i++) {
4566         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4567         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4568       }
4569     }
4570     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4571     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4572     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4573   }
4574 
4575   /* compute other basis functions for non-symmetric problems */
4576   if (!pcbddc->symmetric_primal) {
4577     Mat         B_V=NULL,B_C=NULL;
4578     PetscScalar *marray;
4579 
4580     if (n_constraints) {
4581       Mat S_CCT,C_CRT;
4582 
4583       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4584       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4585       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4586       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4587       if (n_vertices) {
4588         Mat S_VCT;
4589 
4590         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4591         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4592         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4593       }
4594       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4595     } else {
4596       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4597     }
4598     if (n_vertices && n_R) {
4599       PetscScalar    *av,*marray;
4600       const PetscInt *xadj,*adjncy;
4601       PetscInt       n;
4602       PetscBool      flg_row;
4603 
4604       /* B_V = B_V - A_VR^T */
4605       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4606       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4607       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4608       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4609       for (i=0;i<n;i++) {
4610         PetscInt j;
4611         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4612       }
4613       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4614       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4615       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4616     }
4617 
4618     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4619     if (n_vertices) {
4620       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4621       for (i=0;i<n_vertices;i++) {
4622         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4623         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4624         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4625         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4626         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4627         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4628       }
4629       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4630     }
4631     if (B_C) {
4632       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4633       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4634         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4635         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4636         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4637         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4638         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4639         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4640       }
4641       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4642     }
4643     /* coarse basis functions */
4644     for (i=0;i<pcbddc->local_primal_size;i++) {
4645       PetscScalar *y;
4646 
4647       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4648       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4649       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4650       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4651       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4652       if (i<n_vertices) {
4653         y[n_B*i+idx_V_B[i]] = 1.0;
4654       }
4655       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4656       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4657 
4658       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4659         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4660         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4661         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4662         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4663         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4664         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4665       }
4666       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4667     }
4668     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4669     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4670   }
4671 
4672   /* free memory */
4673   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4674   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4675   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4676   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4677   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4678   ierr = PetscFree(work);CHKERRQ(ierr);
4679   if (n_vertices) {
4680     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4681   }
4682   if (n_constraints) {
4683     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4684   }
4685   /* Checking coarse_sub_mat and coarse basis functios */
4686   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4687   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4688   if (pcbddc->dbg_flag) {
4689     Mat         coarse_sub_mat;
4690     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4691     Mat         coarse_phi_D,coarse_phi_B;
4692     Mat         coarse_psi_D,coarse_psi_B;
4693     Mat         A_II,A_BB,A_IB,A_BI;
4694     Mat         C_B,CPHI;
4695     IS          is_dummy;
4696     Vec         mones;
4697     MatType     checkmattype=MATSEQAIJ;
4698     PetscReal   real_value;
4699 
4700     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4701       Mat A;
4702       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4703       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4704       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4705       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4706       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4707       ierr = MatDestroy(&A);CHKERRQ(ierr);
4708     } else {
4709       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4710       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4711       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4712       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4713     }
4714     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4715     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4716     if (!pcbddc->symmetric_primal) {
4717       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4718       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4719     }
4720     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4721 
4722     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4723     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4724     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4725     if (!pcbddc->symmetric_primal) {
4726       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4727       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4728       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4729       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4730       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4731       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4732       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4733       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4734       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4735       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4736       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4737       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4738     } else {
4739       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4740       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4741       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4742       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4743       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4744       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4745       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4746       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4747     }
4748     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4749     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4750     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4751     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4752     if (pcbddc->benign_n) {
4753       Mat               B0_B,B0_BPHI;
4754       const PetscScalar *data2;
4755       PetscScalar       *data;
4756       PetscInt          j;
4757 
4758       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4759       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4760       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4761       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4762       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4763       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4764       for (j=0;j<pcbddc->benign_n;j++) {
4765         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4766         for (i=0;i<pcbddc->local_primal_size;i++) {
4767           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4768           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4769         }
4770       }
4771       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4772       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4773       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4774       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4775       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4776     }
4777 #if 0
4778   {
4779     PetscViewer viewer;
4780     char filename[256];
4781     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4782     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4783     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4784     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4785     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4786     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4787     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4788     if (pcbddc->coarse_phi_B) {
4789       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4790       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4791     }
4792     if (pcbddc->coarse_phi_D) {
4793       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4794       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4795     }
4796     if (pcbddc->coarse_psi_B) {
4797       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4798       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4799     }
4800     if (pcbddc->coarse_psi_D) {
4801       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4802       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4803     }
4804     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4805     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4806     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4807     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4808     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4809     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4810     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4811     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4812     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4813     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4814     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4815   }
4816 #endif
4817     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4818     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4819     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4820     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4821 
4822     /* check constraints */
4823     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4824     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4825     if (!pcbddc->benign_n) { /* TODO: add benign case */
4826       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4827     } else {
4828       PetscScalar *data;
4829       Mat         tmat;
4830       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4831       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4832       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4833       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4834       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4835     }
4836     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4837     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4838     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4839     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4840     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4841     if (!pcbddc->symmetric_primal) {
4842       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4843       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4844       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4845       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4846       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4847     }
4848     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4849     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4850     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4851     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4852     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4853     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4854     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4855     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4856     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4857     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4858     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4859     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4860     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4861     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4862     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4863     if (!pcbddc->symmetric_primal) {
4864       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4865       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4866     }
4867     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4868   }
4869   /* get back data */
4870   *coarse_submat_vals_n = coarse_submat_vals;
4871   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4872   PetscFunctionReturn(0);
4873 }
4874 
4875 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4876 {
4877   Mat            *work_mat;
4878   IS             isrow_s,iscol_s;
4879   PetscBool      rsorted,csorted;
4880   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4881   PetscErrorCode ierr;
4882 
4883   PetscFunctionBegin;
4884   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4885   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4886   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4887   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4888 
4889   if (!rsorted) {
4890     const PetscInt *idxs;
4891     PetscInt *idxs_sorted,i;
4892 
4893     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4894     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4895     for (i=0;i<rsize;i++) {
4896       idxs_perm_r[i] = i;
4897     }
4898     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4899     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4900     for (i=0;i<rsize;i++) {
4901       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4902     }
4903     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4904     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4905   } else {
4906     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4907     isrow_s = isrow;
4908   }
4909 
4910   if (!csorted) {
4911     if (isrow == iscol) {
4912       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4913       iscol_s = isrow_s;
4914     } else {
4915       const PetscInt *idxs;
4916       PetscInt       *idxs_sorted,i;
4917 
4918       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4919       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4920       for (i=0;i<csize;i++) {
4921         idxs_perm_c[i] = i;
4922       }
4923       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4924       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4925       for (i=0;i<csize;i++) {
4926         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4927       }
4928       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4929       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4930     }
4931   } else {
4932     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4933     iscol_s = iscol;
4934   }
4935 
4936   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4937 
4938   if (!rsorted || !csorted) {
4939     Mat      new_mat;
4940     IS       is_perm_r,is_perm_c;
4941 
4942     if (!rsorted) {
4943       PetscInt *idxs_r,i;
4944       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4945       for (i=0;i<rsize;i++) {
4946         idxs_r[idxs_perm_r[i]] = i;
4947       }
4948       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4949       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4950     } else {
4951       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4952     }
4953     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4954 
4955     if (!csorted) {
4956       if (isrow_s == iscol_s) {
4957         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4958         is_perm_c = is_perm_r;
4959       } else {
4960         PetscInt *idxs_c,i;
4961         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4962         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4963         for (i=0;i<csize;i++) {
4964           idxs_c[idxs_perm_c[i]] = i;
4965         }
4966         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4967         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4968       }
4969     } else {
4970       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4971     }
4972     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4973 
4974     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4975     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4976     work_mat[0] = new_mat;
4977     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4978     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4979   }
4980 
4981   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4982   *B = work_mat[0];
4983   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4984   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4985   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4986   PetscFunctionReturn(0);
4987 }
4988 
4989 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4990 {
4991   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4992   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4993   Mat            new_mat,lA;
4994   IS             is_local,is_global;
4995   PetscInt       local_size;
4996   PetscBool      isseqaij;
4997   PetscErrorCode ierr;
4998 
4999   PetscFunctionBegin;
5000   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5001   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5002   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5003   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5004   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5005   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5006   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5007 
5008   /* check */
5009   if (pcbddc->dbg_flag) {
5010     Vec       x,x_change;
5011     PetscReal error;
5012 
5013     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5014     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5015     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5016     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5017     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5018     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5019     if (!pcbddc->change_interior) {
5020       const PetscScalar *x,*y,*v;
5021       PetscReal         lerror = 0.;
5022       PetscInt          i;
5023 
5024       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5025       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5026       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5027       for (i=0;i<local_size;i++)
5028         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5029           lerror = PetscAbsScalar(x[i]-y[i]);
5030       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5031       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5032       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5033       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5034       if (error > PETSC_SMALL) {
5035         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5036           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5037         } else {
5038           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5039         }
5040       }
5041     }
5042     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5043     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5044     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5045     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5046     if (error > PETSC_SMALL) {
5047       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5048         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5049       } else {
5050         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5051       }
5052     }
5053     ierr = VecDestroy(&x);CHKERRQ(ierr);
5054     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5055   }
5056 
5057   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5058   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5059 
5060   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5061   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5062   if (isseqaij) {
5063     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5064     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5065     if (lA) {
5066       Mat work;
5067       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5068       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5069       ierr = MatDestroy(&work);CHKERRQ(ierr);
5070     }
5071   } else {
5072     Mat work_mat;
5073 
5074     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5075     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5076     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5077     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5078     if (lA) {
5079       Mat work;
5080       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5081       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5082       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5083       ierr = MatDestroy(&work);CHKERRQ(ierr);
5084     }
5085   }
5086   if (matis->A->symmetric_set) {
5087     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5088 #if !defined(PETSC_USE_COMPLEX)
5089     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5090 #endif
5091   }
5092   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5093   PetscFunctionReturn(0);
5094 }
5095 
5096 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5097 {
5098   PC_IS*          pcis = (PC_IS*)(pc->data);
5099   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5100   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5101   PetscInt        *idx_R_local=NULL;
5102   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5103   PetscInt        vbs,bs;
5104   PetscBT         bitmask=NULL;
5105   PetscErrorCode  ierr;
5106 
5107   PetscFunctionBegin;
5108   /*
5109     No need to setup local scatters if
5110       - primal space is unchanged
5111         AND
5112       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5113         AND
5114       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5115   */
5116   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5117     PetscFunctionReturn(0);
5118   }
5119   /* destroy old objects */
5120   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5121   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5122   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5123   /* Set Non-overlapping dimensions */
5124   n_B = pcis->n_B;
5125   n_D = pcis->n - n_B;
5126   n_vertices = pcbddc->n_vertices;
5127 
5128   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5129 
5130   /* create auxiliary bitmask and allocate workspace */
5131   if (!sub_schurs || !sub_schurs->reuse_solver) {
5132     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5133     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5134     for (i=0;i<n_vertices;i++) {
5135       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5136     }
5137 
5138     for (i=0, n_R=0; i<pcis->n; i++) {
5139       if (!PetscBTLookup(bitmask,i)) {
5140         idx_R_local[n_R++] = i;
5141       }
5142     }
5143   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5144     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5145 
5146     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5147     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5148   }
5149 
5150   /* Block code */
5151   vbs = 1;
5152   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5153   if (bs>1 && !(n_vertices%bs)) {
5154     PetscBool is_blocked = PETSC_TRUE;
5155     PetscInt  *vary;
5156     if (!sub_schurs || !sub_schurs->reuse_solver) {
5157       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5158       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5159       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5160       /* 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 */
5161       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5162       for (i=0; i<pcis->n/bs; i++) {
5163         if (vary[i]!=0 && vary[i]!=bs) {
5164           is_blocked = PETSC_FALSE;
5165           break;
5166         }
5167       }
5168       ierr = PetscFree(vary);CHKERRQ(ierr);
5169     } else {
5170       /* Verify directly the R set */
5171       for (i=0; i<n_R/bs; i++) {
5172         PetscInt j,node=idx_R_local[bs*i];
5173         for (j=1; j<bs; j++) {
5174           if (node != idx_R_local[bs*i+j]-j) {
5175             is_blocked = PETSC_FALSE;
5176             break;
5177           }
5178         }
5179       }
5180     }
5181     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5182       vbs = bs;
5183       for (i=0;i<n_R/vbs;i++) {
5184         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5185       }
5186     }
5187   }
5188   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5189   if (sub_schurs && sub_schurs->reuse_solver) {
5190     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5191 
5192     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5193     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5194     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5195     reuse_solver->is_R = pcbddc->is_R_local;
5196   } else {
5197     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5198   }
5199 
5200   /* print some info if requested */
5201   if (pcbddc->dbg_flag) {
5202     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5203     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5204     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5205     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5206     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5207     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);
5208     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5209   }
5210 
5211   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5212   if (!sub_schurs || !sub_schurs->reuse_solver) {
5213     IS       is_aux1,is_aux2;
5214     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5215 
5216     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5217     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5218     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5219     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5220     for (i=0; i<n_D; i++) {
5221       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5222     }
5223     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5224     for (i=0, j=0; i<n_R; i++) {
5225       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5226         aux_array1[j++] = i;
5227       }
5228     }
5229     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5230     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5231     for (i=0, j=0; i<n_B; i++) {
5232       if (!PetscBTLookup(bitmask,is_indices[i])) {
5233         aux_array2[j++] = i;
5234       }
5235     }
5236     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5237     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5238     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5239     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5240     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5241 
5242     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5243       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5244       for (i=0, j=0; i<n_R; i++) {
5245         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5246           aux_array1[j++] = i;
5247         }
5248       }
5249       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5250       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5251       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5252     }
5253     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5254     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5255   } else {
5256     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5257     IS                 tis;
5258     PetscInt           schur_size;
5259 
5260     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5261     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5262     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5263     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5264     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5265       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5266       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5267       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5268     }
5269   }
5270   PetscFunctionReturn(0);
5271 }
5272 
5273 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B)
5274 {
5275   MatNullSpace   NullSpace;
5276   Mat            dmat;
5277   const Vec      *nullvecs;
5278   Vec            v,v2,*nullvecs2;
5279   VecScatter     sct;
5280   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5281   PetscBool      nnsp_has_cnst;
5282   PetscErrorCode ierr;
5283 
5284   PetscFunctionBegin;
5285   ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5286   if (!NullSpace) {
5287     ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5288   }
5289   if (NullSpace) PetscFunctionReturn(0);
5290   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5291   if (!NullSpace) {
5292     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5293   }
5294   if (!NullSpace) PetscFunctionReturn(0);
5295   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5296   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5297   ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5298   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5299   bsiz = nnsp_size+!!nnsp_has_cnst;
5300   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5301   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5302   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5303   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5304   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5305   for (k=0;k<nnsp_size;k++) {
5306     PetscScalar *arr;
5307 
5308     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5309     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5310     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5311     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5312     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5313   }
5314   if (nnsp_has_cnst) {
5315     PetscScalar *arr;
5316 
5317     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5318     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5319     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5320     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5321   }
5322   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5323   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5324   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5325   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5326   for (k=0;k<bsiz;k++) {
5327     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5328   }
5329   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5330   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5331   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5332   ierr = VecDestroy(&v);CHKERRQ(ierr);
5333   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5334   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5335   PetscFunctionReturn(0);
5336 }
5337 
5338 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5339 {
5340   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5341   PC_IS          *pcis = (PC_IS*)pc->data;
5342   PC             pc_temp;
5343   Mat            A_RR;
5344   MatNullSpace   nnsp;
5345   MatReuse       reuse;
5346   PetscScalar    m_one = -1.0;
5347   PetscReal      value;
5348   PetscInt       n_D,n_R;
5349   PetscBool      issbaij,opts;
5350   PetscErrorCode ierr;
5351   void           (*f)(void) = 0;
5352   char           dir_prefix[256],neu_prefix[256],str_level[16];
5353   size_t         len;
5354 
5355   PetscFunctionBegin;
5356   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5357   /* compute prefixes */
5358   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5359   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5360   if (!pcbddc->current_level) {
5361     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5362     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5363     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5364     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5365   } else {
5366     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5367     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5368     len -= 15; /* remove "pc_bddc_coarse_" */
5369     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5370     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5371     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5372     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5373     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5374     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5375     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5376     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5377     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5378   }
5379 
5380   /* DIRICHLET PROBLEM */
5381   if (dirichlet) {
5382     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5383     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5384       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5385       if (pcbddc->dbg_flag) {
5386         Mat    A_IIn;
5387 
5388         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5389         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5390         pcis->A_II = A_IIn;
5391       }
5392     }
5393     if (pcbddc->local_mat->symmetric_set) {
5394       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5395     }
5396     /* Matrix for Dirichlet problem is pcis->A_II */
5397     n_D  = pcis->n - pcis->n_B;
5398     opts = PETSC_FALSE;
5399     if (!pcbddc->ksp_D) { /* create object if not yet build */
5400       opts = PETSC_TRUE;
5401       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5402       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5403       /* default */
5404       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5405       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5406       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5407       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5408       if (issbaij) {
5409         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5410       } else {
5411         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5412       }
5413       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5414     }
5415     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5416     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5417     /* Allow user's customization */
5418     if (opts) {
5419       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5420     }
5421     if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */
5422       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5423     }
5424     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5425     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5426     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5427     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5428       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5429       const PetscInt *idxs;
5430       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5431 
5432       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5433       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5434       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5435       for (i=0;i<nl;i++) {
5436         for (d=0;d<cdim;d++) {
5437           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5438         }
5439       }
5440       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5441       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5442       ierr = PetscFree(scoords);CHKERRQ(ierr);
5443     }
5444     if (sub_schurs && sub_schurs->reuse_solver) {
5445       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5446 
5447       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5448     }
5449 
5450     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5451     if (!n_D) {
5452       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5453       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5454     }
5455     /* set ksp_D into pcis data */
5456     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5457     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5458     pcis->ksp_D = pcbddc->ksp_D;
5459   }
5460 
5461   /* NEUMANN PROBLEM */
5462   A_RR = 0;
5463   if (neumann) {
5464     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5465     PetscInt        ibs,mbs;
5466     PetscBool       issbaij, reuse_neumann_solver;
5467     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5468 
5469     reuse_neumann_solver = PETSC_FALSE;
5470     if (sub_schurs && sub_schurs->reuse_solver) {
5471       IS iP;
5472 
5473       reuse_neumann_solver = PETSC_TRUE;
5474       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5475       if (iP) reuse_neumann_solver = PETSC_FALSE;
5476     }
5477     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5478     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5479     if (pcbddc->ksp_R) { /* already created ksp */
5480       PetscInt nn_R;
5481       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5482       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5483       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5484       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5485         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5486         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5487         reuse = MAT_INITIAL_MATRIX;
5488       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5489         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5490           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5491           reuse = MAT_INITIAL_MATRIX;
5492         } else { /* safe to reuse the matrix */
5493           reuse = MAT_REUSE_MATRIX;
5494         }
5495       }
5496       /* last check */
5497       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5498         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5499         reuse = MAT_INITIAL_MATRIX;
5500       }
5501     } else { /* first time, so we need to create the matrix */
5502       reuse = MAT_INITIAL_MATRIX;
5503     }
5504     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5505     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5506     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5507     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5508     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5509       if (matis->A == pcbddc->local_mat) {
5510         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5511         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5512       } else {
5513         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5514       }
5515     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5516       if (matis->A == pcbddc->local_mat) {
5517         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5518         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5519       } else {
5520         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5521       }
5522     }
5523     /* extract A_RR */
5524     if (reuse_neumann_solver) {
5525       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5526 
5527       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5528         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5529         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5530           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5531         } else {
5532           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5533         }
5534       } else {
5535         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5536         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5537         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5538       }
5539     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5540       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5541     }
5542     if (pcbddc->local_mat->symmetric_set) {
5543       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5544     }
5545     opts = PETSC_FALSE;
5546     if (!pcbddc->ksp_R) { /* create object if not present */
5547       opts = PETSC_TRUE;
5548       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5549       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5550       /* default */
5551       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5552       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5553       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5554       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5555       if (issbaij) {
5556         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5557       } else {
5558         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5559       }
5560       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5561     }
5562     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5563     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5564     if (opts) { /* Allow user's customization once */
5565       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5566     }
5567     if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */
5568       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5569     }
5570     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5571     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5572     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5573     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5574       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5575       const PetscInt *idxs;
5576       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5577 
5578       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5579       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5580       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5581       for (i=0;i<nl;i++) {
5582         for (d=0;d<cdim;d++) {
5583           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5584         }
5585       }
5586       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5587       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5588       ierr = PetscFree(scoords);CHKERRQ(ierr);
5589     }
5590 
5591     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5592     if (!n_R) {
5593       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5594       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5595     }
5596     /* Reuse solver if it is present */
5597     if (reuse_neumann_solver) {
5598       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5599 
5600       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5601     }
5602   }
5603 
5604   if (pcbddc->dbg_flag) {
5605     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5606     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5607     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5608   }
5609 
5610   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5611   if (pcbddc->NullSpace_corr[0]) {
5612     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5613   }
5614   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5615     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5616   }
5617   if (neumann && pcbddc->NullSpace_corr[2]) {
5618     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5619   }
5620   /* check Dirichlet and Neumann solvers */
5621   if (pcbddc->dbg_flag) {
5622     if (dirichlet) { /* Dirichlet */
5623       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5624       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5625       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5626       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5627       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5628       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5629       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);
5630       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5631     }
5632     if (neumann) { /* Neumann */
5633       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5634       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5635       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5636       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5637       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5638       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5639       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);
5640       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5641     }
5642   }
5643   /* free Neumann problem's matrix */
5644   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5645   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5646   PetscFunctionReturn(0);
5647 }
5648 
5649 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5650 {
5651   PetscErrorCode  ierr;
5652   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5653   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5654   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5655 
5656   PetscFunctionBegin;
5657   if (!reuse_solver) {
5658     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5659   }
5660   if (!pcbddc->switch_static) {
5661     if (applytranspose && pcbddc->local_auxmat1) {
5662       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5663       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5664     }
5665     if (!reuse_solver) {
5666       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5667       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5668     } else {
5669       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5670 
5671       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5672       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5673     }
5674   } else {
5675     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5676     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5677     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5678     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5679     if (applytranspose && pcbddc->local_auxmat1) {
5680       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5681       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5682       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5683       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5684     }
5685   }
5686   if (!reuse_solver || pcbddc->switch_static) {
5687     if (applytranspose) {
5688       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5689     } else {
5690       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5691     }
5692     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5693   } else {
5694     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5695 
5696     if (applytranspose) {
5697       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5698     } else {
5699       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5700     }
5701   }
5702   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5703   if (!pcbddc->switch_static) {
5704     if (!reuse_solver) {
5705       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5706       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5707     } else {
5708       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5709 
5710       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5711       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5712     }
5713     if (!applytranspose && pcbddc->local_auxmat1) {
5714       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5715       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5716     }
5717   } else {
5718     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5719     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5720     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5721     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5722     if (!applytranspose && pcbddc->local_auxmat1) {
5723       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5724       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5725     }
5726     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5727     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5728     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5729     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5730   }
5731   PetscFunctionReturn(0);
5732 }
5733 
5734 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5735 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5736 {
5737   PetscErrorCode ierr;
5738   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5739   PC_IS*            pcis = (PC_IS*)  (pc->data);
5740   const PetscScalar zero = 0.0;
5741 
5742   PetscFunctionBegin;
5743   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5744   if (!pcbddc->benign_apply_coarse_only) {
5745     if (applytranspose) {
5746       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5747       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5748     } else {
5749       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5750       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5751     }
5752   } else {
5753     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5754   }
5755 
5756   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5757   if (pcbddc->benign_n) {
5758     PetscScalar *array;
5759     PetscInt    j;
5760 
5761     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5762     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5763     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5764   }
5765 
5766   /* start communications from local primal nodes to rhs of coarse solver */
5767   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5768   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5769   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5770 
5771   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5772   if (pcbddc->coarse_ksp) {
5773     Mat          coarse_mat;
5774     Vec          rhs,sol;
5775     MatNullSpace nullsp;
5776     PetscBool    isbddc = PETSC_FALSE;
5777 
5778     if (pcbddc->benign_have_null) {
5779       PC        coarse_pc;
5780 
5781       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5782       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5783       /* we need to propagate to coarser levels the need for a possible benign correction */
5784       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5785         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5786         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5787         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5788       }
5789     }
5790     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5791     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5792     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5793     if (applytranspose) {
5794       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5795       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5796       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5797       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5798       if (nullsp) {
5799         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5800       }
5801     } else {
5802       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5803       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5804         PC        coarse_pc;
5805 
5806         if (nullsp) {
5807           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5808         }
5809         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5810         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5811         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5812         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5813       } else {
5814         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5815         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5816         if (nullsp) {
5817           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5818         }
5819       }
5820     }
5821     /* we don't need the benign correction at coarser levels anymore */
5822     if (pcbddc->benign_have_null && isbddc) {
5823       PC        coarse_pc;
5824       PC_BDDC*  coarsepcbddc;
5825 
5826       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5827       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5828       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5829       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5830     }
5831   }
5832 
5833   /* Local solution on R nodes */
5834   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5835     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5836   }
5837   /* communications from coarse sol to local primal nodes */
5838   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5839   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5840 
5841   /* Sum contributions from the two levels */
5842   if (!pcbddc->benign_apply_coarse_only) {
5843     if (applytranspose) {
5844       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5845       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5846     } else {
5847       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5848       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5849     }
5850     /* store p0 */
5851     if (pcbddc->benign_n) {
5852       PetscScalar *array;
5853       PetscInt    j;
5854 
5855       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5856       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5857       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5858     }
5859   } else { /* expand the coarse solution */
5860     if (applytranspose) {
5861       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5862     } else {
5863       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5864     }
5865   }
5866   PetscFunctionReturn(0);
5867 }
5868 
5869 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5870 {
5871   PetscErrorCode ierr;
5872   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5873   PetscScalar    *array;
5874   Vec            from,to;
5875 
5876   PetscFunctionBegin;
5877   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5878     from = pcbddc->coarse_vec;
5879     to = pcbddc->vec1_P;
5880     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5881       Vec tvec;
5882 
5883       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5884       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5885       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5886       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5887       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5888       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5889     }
5890   } else { /* from local to global -> put data in coarse right hand side */
5891     from = pcbddc->vec1_P;
5892     to = pcbddc->coarse_vec;
5893   }
5894   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5895   PetscFunctionReturn(0);
5896 }
5897 
5898 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5899 {
5900   PetscErrorCode ierr;
5901   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5902   PetscScalar    *array;
5903   Vec            from,to;
5904 
5905   PetscFunctionBegin;
5906   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5907     from = pcbddc->coarse_vec;
5908     to = pcbddc->vec1_P;
5909   } else { /* from local to global -> put data in coarse right hand side */
5910     from = pcbddc->vec1_P;
5911     to = pcbddc->coarse_vec;
5912   }
5913   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5914   if (smode == SCATTER_FORWARD) {
5915     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5916       Vec tvec;
5917 
5918       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5919       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5920       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5921       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5922     }
5923   } else {
5924     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5925      ierr = VecResetArray(from);CHKERRQ(ierr);
5926     }
5927   }
5928   PetscFunctionReturn(0);
5929 }
5930 
5931 /* uncomment for testing purposes */
5932 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5933 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5934 {
5935   PetscErrorCode    ierr;
5936   PC_IS*            pcis = (PC_IS*)(pc->data);
5937   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5938   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5939   /* one and zero */
5940   PetscScalar       one=1.0,zero=0.0;
5941   /* space to store constraints and their local indices */
5942   PetscScalar       *constraints_data;
5943   PetscInt          *constraints_idxs,*constraints_idxs_B;
5944   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5945   PetscInt          *constraints_n;
5946   /* iterators */
5947   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5948   /* BLAS integers */
5949   PetscBLASInt      lwork,lierr;
5950   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5951   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5952   /* reuse */
5953   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5954   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5955   /* change of basis */
5956   PetscBool         qr_needed;
5957   PetscBT           change_basis,qr_needed_idx;
5958   /* auxiliary stuff */
5959   PetscInt          *nnz,*is_indices;
5960   PetscInt          ncc;
5961   /* some quantities */
5962   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5963   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5964   PetscReal         tol; /* tolerance for retaining eigenmodes */
5965 
5966   PetscFunctionBegin;
5967   tol  = PetscSqrtReal(PETSC_SMALL);
5968   /* Destroy Mat objects computed previously */
5969   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5970   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5971   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5972   /* save info on constraints from previous setup (if any) */
5973   olocal_primal_size = pcbddc->local_primal_size;
5974   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5975   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5976   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5977   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5978   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5979   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5980 
5981   if (!pcbddc->adaptive_selection) {
5982     IS           ISForVertices,*ISForFaces,*ISForEdges;
5983     MatNullSpace nearnullsp;
5984     const Vec    *nearnullvecs;
5985     Vec          *localnearnullsp;
5986     PetscScalar  *array;
5987     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5988     PetscBool    nnsp_has_cnst;
5989     /* LAPACK working arrays for SVD or POD */
5990     PetscBool    skip_lapack,boolforchange;
5991     PetscScalar  *work;
5992     PetscReal    *singular_vals;
5993 #if defined(PETSC_USE_COMPLEX)
5994     PetscReal    *rwork;
5995 #endif
5996 #if defined(PETSC_MISSING_LAPACK_GESVD)
5997     PetscScalar  *temp_basis,*correlation_mat;
5998 #else
5999     PetscBLASInt dummy_int=1;
6000     PetscScalar  dummy_scalar=1.;
6001 #endif
6002 
6003     /* Get index sets for faces, edges and vertices from graph */
6004     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6005     /* print some info */
6006     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6007       PetscInt nv;
6008 
6009       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6010       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6011       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6012       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6013       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6014       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6015       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6016       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6017       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6018     }
6019 
6020     /* free unneeded index sets */
6021     if (!pcbddc->use_vertices) {
6022       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6023     }
6024     if (!pcbddc->use_edges) {
6025       for (i=0;i<n_ISForEdges;i++) {
6026         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6027       }
6028       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6029       n_ISForEdges = 0;
6030     }
6031     if (!pcbddc->use_faces) {
6032       for (i=0;i<n_ISForFaces;i++) {
6033         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6034       }
6035       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6036       n_ISForFaces = 0;
6037     }
6038 
6039     /* check if near null space is attached to global mat */
6040     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6041     if (nearnullsp) {
6042       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6043       /* remove any stored info */
6044       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6045       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6046       /* store information for BDDC solver reuse */
6047       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6048       pcbddc->onearnullspace = nearnullsp;
6049       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6050       for (i=0;i<nnsp_size;i++) {
6051         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6052       }
6053     } else { /* if near null space is not provided BDDC uses constants by default */
6054       nnsp_size = 0;
6055       nnsp_has_cnst = PETSC_TRUE;
6056     }
6057     /* get max number of constraints on a single cc */
6058     max_constraints = nnsp_size;
6059     if (nnsp_has_cnst) max_constraints++;
6060 
6061     /*
6062          Evaluate maximum storage size needed by the procedure
6063          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6064          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6065          There can be multiple constraints per connected component
6066                                                                                                                                                            */
6067     n_vertices = 0;
6068     if (ISForVertices) {
6069       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6070     }
6071     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6072     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6073 
6074     total_counts = n_ISForFaces+n_ISForEdges;
6075     total_counts *= max_constraints;
6076     total_counts += n_vertices;
6077     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6078 
6079     total_counts = 0;
6080     max_size_of_constraint = 0;
6081     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6082       IS used_is;
6083       if (i<n_ISForEdges) {
6084         used_is = ISForEdges[i];
6085       } else {
6086         used_is = ISForFaces[i-n_ISForEdges];
6087       }
6088       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6089       total_counts += j;
6090       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6091     }
6092     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);
6093 
6094     /* get local part of global near null space vectors */
6095     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6096     for (k=0;k<nnsp_size;k++) {
6097       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6098       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6099       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6100     }
6101 
6102     /* whether or not to skip lapack calls */
6103     skip_lapack = PETSC_TRUE;
6104     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6105 
6106     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6107     if (!skip_lapack) {
6108       PetscScalar temp_work;
6109 
6110 #if defined(PETSC_MISSING_LAPACK_GESVD)
6111       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6112       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6113       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6114       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6115 #if defined(PETSC_USE_COMPLEX)
6116       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6117 #endif
6118       /* now we evaluate the optimal workspace using query with lwork=-1 */
6119       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6120       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6121       lwork = -1;
6122       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6123 #if !defined(PETSC_USE_COMPLEX)
6124       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6125 #else
6126       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6127 #endif
6128       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6129       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6130 #else /* on missing GESVD */
6131       /* SVD */
6132       PetscInt max_n,min_n;
6133       max_n = max_size_of_constraint;
6134       min_n = max_constraints;
6135       if (max_size_of_constraint < max_constraints) {
6136         min_n = max_size_of_constraint;
6137         max_n = max_constraints;
6138       }
6139       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6140 #if defined(PETSC_USE_COMPLEX)
6141       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6142 #endif
6143       /* now we evaluate the optimal workspace using query with lwork=-1 */
6144       lwork = -1;
6145       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6146       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6147       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6148       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6149 #if !defined(PETSC_USE_COMPLEX)
6150       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));
6151 #else
6152       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));
6153 #endif
6154       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6155       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6156 #endif /* on missing GESVD */
6157       /* Allocate optimal workspace */
6158       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6159       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6160     }
6161     /* Now we can loop on constraining sets */
6162     total_counts = 0;
6163     constraints_idxs_ptr[0] = 0;
6164     constraints_data_ptr[0] = 0;
6165     /* vertices */
6166     if (n_vertices) {
6167       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6168       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6169       for (i=0;i<n_vertices;i++) {
6170         constraints_n[total_counts] = 1;
6171         constraints_data[total_counts] = 1.0;
6172         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6173         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6174         total_counts++;
6175       }
6176       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6177       n_vertices = total_counts;
6178     }
6179 
6180     /* edges and faces */
6181     total_counts_cc = total_counts;
6182     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6183       IS        used_is;
6184       PetscBool idxs_copied = PETSC_FALSE;
6185 
6186       if (ncc<n_ISForEdges) {
6187         used_is = ISForEdges[ncc];
6188         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6189       } else {
6190         used_is = ISForFaces[ncc-n_ISForEdges];
6191         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6192       }
6193       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6194 
6195       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6196       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6197       /* change of basis should not be performed on local periodic nodes */
6198       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6199       if (nnsp_has_cnst) {
6200         PetscScalar quad_value;
6201 
6202         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6203         idxs_copied = PETSC_TRUE;
6204 
6205         if (!pcbddc->use_nnsp_true) {
6206           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6207         } else {
6208           quad_value = 1.0;
6209         }
6210         for (j=0;j<size_of_constraint;j++) {
6211           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6212         }
6213         temp_constraints++;
6214         total_counts++;
6215       }
6216       for (k=0;k<nnsp_size;k++) {
6217         PetscReal real_value;
6218         PetscScalar *ptr_to_data;
6219 
6220         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6221         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6222         for (j=0;j<size_of_constraint;j++) {
6223           ptr_to_data[j] = array[is_indices[j]];
6224         }
6225         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6226         /* check if array is null on the connected component */
6227         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6228         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6229         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6230           temp_constraints++;
6231           total_counts++;
6232           if (!idxs_copied) {
6233             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6234             idxs_copied = PETSC_TRUE;
6235           }
6236         }
6237       }
6238       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6239       valid_constraints = temp_constraints;
6240       if (!pcbddc->use_nnsp_true && temp_constraints) {
6241         if (temp_constraints == 1) { /* just normalize the constraint */
6242           PetscScalar norm,*ptr_to_data;
6243 
6244           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6245           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6246           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6247           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6248           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6249         } else { /* perform SVD */
6250           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6251 
6252 #if defined(PETSC_MISSING_LAPACK_GESVD)
6253           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6254              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6255              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6256                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6257                 from that computed using LAPACKgesvd
6258              -> This is due to a different computation of eigenvectors in LAPACKheev
6259              -> The quality of the POD-computed basis will be the same */
6260           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6261           /* Store upper triangular part of correlation matrix */
6262           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6263           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6264           for (j=0;j<temp_constraints;j++) {
6265             for (k=0;k<j+1;k++) {
6266               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));
6267             }
6268           }
6269           /* compute eigenvalues and eigenvectors of correlation matrix */
6270           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6271           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6272 #if !defined(PETSC_USE_COMPLEX)
6273           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6274 #else
6275           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6276 #endif
6277           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6278           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6279           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6280           j = 0;
6281           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6282           total_counts = total_counts-j;
6283           valid_constraints = temp_constraints-j;
6284           /* scale and copy POD basis into used quadrature memory */
6285           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6286           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6287           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6288           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6289           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6290           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6291           if (j<temp_constraints) {
6292             PetscInt ii;
6293             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6294             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6295             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));
6296             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6297             for (k=0;k<temp_constraints-j;k++) {
6298               for (ii=0;ii<size_of_constraint;ii++) {
6299                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6300               }
6301             }
6302           }
6303 #else  /* on missing GESVD */
6304           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6305           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6306           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6307           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6308 #if !defined(PETSC_USE_COMPLEX)
6309           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));
6310 #else
6311           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));
6312 #endif
6313           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6314           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6315           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6316           k = temp_constraints;
6317           if (k > size_of_constraint) k = size_of_constraint;
6318           j = 0;
6319           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6320           valid_constraints = k-j;
6321           total_counts = total_counts-temp_constraints+valid_constraints;
6322 #endif /* on missing GESVD */
6323         }
6324       }
6325       /* update pointers information */
6326       if (valid_constraints) {
6327         constraints_n[total_counts_cc] = valid_constraints;
6328         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6329         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6330         /* set change_of_basis flag */
6331         if (boolforchange) {
6332           PetscBTSet(change_basis,total_counts_cc);
6333         }
6334         total_counts_cc++;
6335       }
6336     }
6337     /* free workspace */
6338     if (!skip_lapack) {
6339       ierr = PetscFree(work);CHKERRQ(ierr);
6340 #if defined(PETSC_USE_COMPLEX)
6341       ierr = PetscFree(rwork);CHKERRQ(ierr);
6342 #endif
6343       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6344 #if defined(PETSC_MISSING_LAPACK_GESVD)
6345       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6346       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6347 #endif
6348     }
6349     for (k=0;k<nnsp_size;k++) {
6350       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6351     }
6352     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6353     /* free index sets of faces, edges and vertices */
6354     for (i=0;i<n_ISForFaces;i++) {
6355       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6356     }
6357     if (n_ISForFaces) {
6358       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6359     }
6360     for (i=0;i<n_ISForEdges;i++) {
6361       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6362     }
6363     if (n_ISForEdges) {
6364       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6365     }
6366     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6367   } else {
6368     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6369 
6370     total_counts = 0;
6371     n_vertices = 0;
6372     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6373       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6374     }
6375     max_constraints = 0;
6376     total_counts_cc = 0;
6377     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6378       total_counts += pcbddc->adaptive_constraints_n[i];
6379       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6380       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6381     }
6382     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6383     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6384     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6385     constraints_data = pcbddc->adaptive_constraints_data;
6386     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6387     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6388     total_counts_cc = 0;
6389     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6390       if (pcbddc->adaptive_constraints_n[i]) {
6391         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6392       }
6393     }
6394 
6395     max_size_of_constraint = 0;
6396     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]);
6397     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6398     /* Change of basis */
6399     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6400     if (pcbddc->use_change_of_basis) {
6401       for (i=0;i<sub_schurs->n_subs;i++) {
6402         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6403           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6404         }
6405       }
6406     }
6407   }
6408   pcbddc->local_primal_size = total_counts;
6409   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6410 
6411   /* map constraints_idxs in boundary numbering */
6412   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6413   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);
6414 
6415   /* Create constraint matrix */
6416   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6417   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6418   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6419 
6420   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6421   /* determine if a QR strategy is needed for change of basis */
6422   qr_needed = pcbddc->use_qr_single;
6423   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6424   total_primal_vertices=0;
6425   pcbddc->local_primal_size_cc = 0;
6426   for (i=0;i<total_counts_cc;i++) {
6427     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6428     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6429       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6430       pcbddc->local_primal_size_cc += 1;
6431     } else if (PetscBTLookup(change_basis,i)) {
6432       for (k=0;k<constraints_n[i];k++) {
6433         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6434       }
6435       pcbddc->local_primal_size_cc += constraints_n[i];
6436       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6437         PetscBTSet(qr_needed_idx,i);
6438         qr_needed = PETSC_TRUE;
6439       }
6440     } else {
6441       pcbddc->local_primal_size_cc += 1;
6442     }
6443   }
6444   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6445   pcbddc->n_vertices = total_primal_vertices;
6446   /* permute indices in order to have a sorted set of vertices */
6447   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6448   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);
6449   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6450   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6451 
6452   /* nonzero structure of constraint matrix */
6453   /* and get reference dof for local constraints */
6454   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6455   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6456 
6457   j = total_primal_vertices;
6458   total_counts = total_primal_vertices;
6459   cum = total_primal_vertices;
6460   for (i=n_vertices;i<total_counts_cc;i++) {
6461     if (!PetscBTLookup(change_basis,i)) {
6462       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6463       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6464       cum++;
6465       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6466       for (k=0;k<constraints_n[i];k++) {
6467         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6468         nnz[j+k] = size_of_constraint;
6469       }
6470       j += constraints_n[i];
6471     }
6472   }
6473   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6474   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6475   ierr = PetscFree(nnz);CHKERRQ(ierr);
6476 
6477   /* set values in constraint matrix */
6478   for (i=0;i<total_primal_vertices;i++) {
6479     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6480   }
6481   total_counts = total_primal_vertices;
6482   for (i=n_vertices;i<total_counts_cc;i++) {
6483     if (!PetscBTLookup(change_basis,i)) {
6484       PetscInt *cols;
6485 
6486       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6487       cols = constraints_idxs+constraints_idxs_ptr[i];
6488       for (k=0;k<constraints_n[i];k++) {
6489         PetscInt    row = total_counts+k;
6490         PetscScalar *vals;
6491 
6492         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6493         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6494       }
6495       total_counts += constraints_n[i];
6496     }
6497   }
6498   /* assembling */
6499   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6500   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6501   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6502 
6503   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6504   if (pcbddc->use_change_of_basis) {
6505     /* dual and primal dofs on a single cc */
6506     PetscInt     dual_dofs,primal_dofs;
6507     /* working stuff for GEQRF */
6508     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6509     PetscBLASInt lqr_work;
6510     /* working stuff for UNGQR */
6511     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6512     PetscBLASInt lgqr_work;
6513     /* working stuff for TRTRS */
6514     PetscScalar  *trs_rhs = NULL;
6515     PetscBLASInt Blas_NRHS;
6516     /* pointers for values insertion into change of basis matrix */
6517     PetscInt     *start_rows,*start_cols;
6518     PetscScalar  *start_vals;
6519     /* working stuff for values insertion */
6520     PetscBT      is_primal;
6521     PetscInt     *aux_primal_numbering_B;
6522     /* matrix sizes */
6523     PetscInt     global_size,local_size;
6524     /* temporary change of basis */
6525     Mat          localChangeOfBasisMatrix;
6526     /* extra space for debugging */
6527     PetscScalar  *dbg_work = NULL;
6528 
6529     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6530     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6531     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6532     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6533     /* nonzeros for local mat */
6534     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6535     if (!pcbddc->benign_change || pcbddc->fake_change) {
6536       for (i=0;i<pcis->n;i++) nnz[i]=1;
6537     } else {
6538       const PetscInt *ii;
6539       PetscInt       n;
6540       PetscBool      flg_row;
6541       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6542       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6543       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6544     }
6545     for (i=n_vertices;i<total_counts_cc;i++) {
6546       if (PetscBTLookup(change_basis,i)) {
6547         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6548         if (PetscBTLookup(qr_needed_idx,i)) {
6549           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6550         } else {
6551           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6552           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6553         }
6554       }
6555     }
6556     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6557     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6558     ierr = PetscFree(nnz);CHKERRQ(ierr);
6559     /* Set interior change in the matrix */
6560     if (!pcbddc->benign_change || pcbddc->fake_change) {
6561       for (i=0;i<pcis->n;i++) {
6562         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6563       }
6564     } else {
6565       const PetscInt *ii,*jj;
6566       PetscScalar    *aa;
6567       PetscInt       n;
6568       PetscBool      flg_row;
6569       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6570       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6571       for (i=0;i<n;i++) {
6572         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6573       }
6574       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6575       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6576     }
6577 
6578     if (pcbddc->dbg_flag) {
6579       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6580       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6581     }
6582 
6583 
6584     /* Now we loop on the constraints which need a change of basis */
6585     /*
6586        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6587        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6588 
6589        Basic blocks of change of basis matrix T computed by
6590 
6591           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6592 
6593             | 1        0   ...        0         s_1/S |
6594             | 0        1   ...        0         s_2/S |
6595             |              ...                        |
6596             | 0        ...            1     s_{n-1}/S |
6597             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6598 
6599             with S = \sum_{i=1}^n s_i^2
6600             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6601                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6602 
6603           - QR decomposition of constraints otherwise
6604     */
6605     if (qr_needed && max_size_of_constraint) {
6606       /* space to store Q */
6607       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6608       /* array to store scaling factors for reflectors */
6609       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6610       /* first we issue queries for optimal work */
6611       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6612       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6613       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6614       lqr_work = -1;
6615       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6616       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6617       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6618       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6619       lgqr_work = -1;
6620       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6621       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6622       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6623       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6624       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6625       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6626       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6627       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6628       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6629       /* array to store rhs and solution of triangular solver */
6630       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6631       /* allocating workspace for check */
6632       if (pcbddc->dbg_flag) {
6633         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6634       }
6635     }
6636     /* array to store whether a node is primal or not */
6637     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6638     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6639     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6640     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);
6641     for (i=0;i<total_primal_vertices;i++) {
6642       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6643     }
6644     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6645 
6646     /* loop on constraints and see whether or not they need a change of basis and compute it */
6647     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6648       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6649       if (PetscBTLookup(change_basis,total_counts)) {
6650         /* get constraint info */
6651         primal_dofs = constraints_n[total_counts];
6652         dual_dofs = size_of_constraint-primal_dofs;
6653 
6654         if (pcbddc->dbg_flag) {
6655           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);
6656         }
6657 
6658         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6659 
6660           /* copy quadrature constraints for change of basis check */
6661           if (pcbddc->dbg_flag) {
6662             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6663           }
6664           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6665           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6666 
6667           /* compute QR decomposition of constraints */
6668           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6669           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6670           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6671           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6672           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6673           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6674           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6675 
6676           /* explictly compute R^-T */
6677           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6678           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6679           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6680           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6681           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6682           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6683           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6684           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6685           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6686           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6687 
6688           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6689           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6690           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6691           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6692           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6693           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6694           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6695           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6696           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6697 
6698           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6699              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6700              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6701           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6702           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6703           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6704           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6705           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6706           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6707           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6708           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));
6709           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6710           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6711 
6712           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6713           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6714           /* insert cols for primal dofs */
6715           for (j=0;j<primal_dofs;j++) {
6716             start_vals = &qr_basis[j*size_of_constraint];
6717             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6718             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6719           }
6720           /* insert cols for dual dofs */
6721           for (j=0,k=0;j<dual_dofs;k++) {
6722             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6723               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6724               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6725               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6726               j++;
6727             }
6728           }
6729 
6730           /* check change of basis */
6731           if (pcbddc->dbg_flag) {
6732             PetscInt   ii,jj;
6733             PetscBool valid_qr=PETSC_TRUE;
6734             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6735             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6736             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6737             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6738             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6739             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6740             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6741             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));
6742             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6743             for (jj=0;jj<size_of_constraint;jj++) {
6744               for (ii=0;ii<primal_dofs;ii++) {
6745                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6746                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6747               }
6748             }
6749             if (!valid_qr) {
6750               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6751               for (jj=0;jj<size_of_constraint;jj++) {
6752                 for (ii=0;ii<primal_dofs;ii++) {
6753                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6754                     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);
6755                   }
6756                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6757                     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);
6758                   }
6759                 }
6760               }
6761             } else {
6762               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6763             }
6764           }
6765         } else { /* simple transformation block */
6766           PetscInt    row,col;
6767           PetscScalar val,norm;
6768 
6769           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6770           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6771           for (j=0;j<size_of_constraint;j++) {
6772             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6773             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6774             if (!PetscBTLookup(is_primal,row_B)) {
6775               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6776               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6777               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6778             } else {
6779               for (k=0;k<size_of_constraint;k++) {
6780                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6781                 if (row != col) {
6782                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6783                 } else {
6784                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6785                 }
6786                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6787               }
6788             }
6789           }
6790           if (pcbddc->dbg_flag) {
6791             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6792           }
6793         }
6794       } else {
6795         if (pcbddc->dbg_flag) {
6796           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6797         }
6798       }
6799     }
6800 
6801     /* free workspace */
6802     if (qr_needed) {
6803       if (pcbddc->dbg_flag) {
6804         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6805       }
6806       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6807       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6808       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6809       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6810       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6811     }
6812     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6813     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6814     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6815 
6816     /* assembling of global change of variable */
6817     if (!pcbddc->fake_change) {
6818       Mat      tmat;
6819       PetscInt bs;
6820 
6821       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6822       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6823       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6824       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6825       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6826       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6827       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6828       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6829       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6830       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6831       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6832       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6833       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6834       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6835       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6836       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6837       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6838       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6839       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6840       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6841 
6842       /* check */
6843       if (pcbddc->dbg_flag) {
6844         PetscReal error;
6845         Vec       x,x_change;
6846 
6847         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6848         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6849         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6850         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6851         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6852         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6853         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6854         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6855         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6856         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6857         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6858         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6859         if (error > PETSC_SMALL) {
6860           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6861         }
6862         ierr = VecDestroy(&x);CHKERRQ(ierr);
6863         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6864       }
6865       /* adapt sub_schurs computed (if any) */
6866       if (pcbddc->use_deluxe_scaling) {
6867         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6868 
6869         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");
6870         if (sub_schurs && sub_schurs->S_Ej_all) {
6871           Mat                    S_new,tmat;
6872           IS                     is_all_N,is_V_Sall = NULL;
6873 
6874           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6875           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6876           if (pcbddc->deluxe_zerorows) {
6877             ISLocalToGlobalMapping NtoSall;
6878             IS                     is_V;
6879             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6880             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6881             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6882             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6883             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6884           }
6885           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6886           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6887           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6888           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6889           if (pcbddc->deluxe_zerorows) {
6890             const PetscScalar *array;
6891             const PetscInt    *idxs_V,*idxs_all;
6892             PetscInt          i,n_V;
6893 
6894             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6895             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6896             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6897             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6898             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6899             for (i=0;i<n_V;i++) {
6900               PetscScalar val;
6901               PetscInt    idx;
6902 
6903               idx = idxs_V[i];
6904               val = array[idxs_all[idxs_V[i]]];
6905               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6906             }
6907             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6908             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6909             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6910             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6911             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6912           }
6913           sub_schurs->S_Ej_all = S_new;
6914           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6915           if (sub_schurs->sum_S_Ej_all) {
6916             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6917             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6918             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6919             if (pcbddc->deluxe_zerorows) {
6920               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6921             }
6922             sub_schurs->sum_S_Ej_all = S_new;
6923             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6924           }
6925           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6926           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6927         }
6928         /* destroy any change of basis context in sub_schurs */
6929         if (sub_schurs && sub_schurs->change) {
6930           PetscInt i;
6931 
6932           for (i=0;i<sub_schurs->n_subs;i++) {
6933             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6934           }
6935           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6936         }
6937       }
6938       if (pcbddc->switch_static) { /* need to save the local change */
6939         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6940       } else {
6941         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6942       }
6943       /* determine if any process has changed the pressures locally */
6944       pcbddc->change_interior = pcbddc->benign_have_null;
6945     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6946       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6947       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6948       pcbddc->use_qr_single = qr_needed;
6949     }
6950   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6951     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6952       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6953       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6954     } else {
6955       Mat benign_global = NULL;
6956       if (pcbddc->benign_have_null) {
6957         Mat M;
6958 
6959         pcbddc->change_interior = PETSC_TRUE;
6960         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6961         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6962         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6963         if (pcbddc->benign_change) {
6964           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6965           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6966         } else {
6967           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6968           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6969         }
6970         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6971         ierr = MatDestroy(&M);CHKERRQ(ierr);
6972         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6973         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6974       }
6975       if (pcbddc->user_ChangeOfBasisMatrix) {
6976         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6977         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6978       } else if (pcbddc->benign_have_null) {
6979         pcbddc->ChangeOfBasisMatrix = benign_global;
6980       }
6981     }
6982     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6983       IS             is_global;
6984       const PetscInt *gidxs;
6985 
6986       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6987       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6988       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6989       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6990       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6991     }
6992   }
6993   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6994     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6995   }
6996 
6997   if (!pcbddc->fake_change) {
6998     /* add pressure dofs to set of primal nodes for numbering purposes */
6999     for (i=0;i<pcbddc->benign_n;i++) {
7000       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7001       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7002       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7003       pcbddc->local_primal_size_cc++;
7004       pcbddc->local_primal_size++;
7005     }
7006 
7007     /* check if a new primal space has been introduced (also take into account benign trick) */
7008     pcbddc->new_primal_space_local = PETSC_TRUE;
7009     if (olocal_primal_size == pcbddc->local_primal_size) {
7010       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7011       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7012       if (!pcbddc->new_primal_space_local) {
7013         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7014         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7015       }
7016     }
7017     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7018     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7019   }
7020   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7021 
7022   /* flush dbg viewer */
7023   if (pcbddc->dbg_flag) {
7024     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7025   }
7026 
7027   /* free workspace */
7028   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7029   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7030   if (!pcbddc->adaptive_selection) {
7031     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7032     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7033   } else {
7034     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7035                       pcbddc->adaptive_constraints_idxs_ptr,
7036                       pcbddc->adaptive_constraints_data_ptr,
7037                       pcbddc->adaptive_constraints_idxs,
7038                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7039     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7040     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7041   }
7042   PetscFunctionReturn(0);
7043 }
7044 /* #undef PETSC_MISSING_LAPACK_GESVD */
7045 
7046 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7047 {
7048   ISLocalToGlobalMapping map;
7049   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7050   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7051   PetscInt               i,N;
7052   PetscBool              rcsr = PETSC_FALSE;
7053   PetscErrorCode         ierr;
7054 
7055   PetscFunctionBegin;
7056   if (pcbddc->recompute_topography) {
7057     pcbddc->graphanalyzed = PETSC_FALSE;
7058     /* Reset previously computed graph */
7059     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7060     /* Init local Graph struct */
7061     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7062     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7063     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7064 
7065     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7066       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7067     }
7068     /* Check validity of the csr graph passed in by the user */
7069     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);
7070 
7071     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7072     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7073       PetscInt  *xadj,*adjncy;
7074       PetscInt  nvtxs;
7075       PetscBool flg_row=PETSC_FALSE;
7076 
7077       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7078       if (flg_row) {
7079         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7080         pcbddc->computed_rowadj = PETSC_TRUE;
7081       }
7082       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7083       rcsr = PETSC_TRUE;
7084     }
7085     if (pcbddc->dbg_flag) {
7086       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7087     }
7088 
7089     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7090       PetscReal    *lcoords;
7091       PetscInt     n;
7092       MPI_Datatype dimrealtype;
7093 
7094       /* TODO: support for blocked */
7095       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);
7096       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7097       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7098       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7099       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7100       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7101       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7102       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7103       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7104 
7105       pcbddc->mat_graph->coords = lcoords;
7106       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7107       pcbddc->mat_graph->cnloc  = n;
7108     }
7109     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);
7110     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7111 
7112     /* Setup of Graph */
7113     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7114     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7115 
7116     /* attach info on disconnected subdomains if present */
7117     if (pcbddc->n_local_subs) {
7118       PetscInt *local_subs;
7119 
7120       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
7121       for (i=0;i<pcbddc->n_local_subs;i++) {
7122         const PetscInt *idxs;
7123         PetscInt       nl,j;
7124 
7125         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7126         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7127         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7128         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7129       }
7130       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
7131       pcbddc->mat_graph->local_subs = local_subs;
7132     }
7133   }
7134 
7135   if (!pcbddc->graphanalyzed) {
7136     /* Graph's connected components analysis */
7137     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7138     pcbddc->graphanalyzed = PETSC_TRUE;
7139     pcbddc->corner_selected = pcbddc->corner_selection;
7140   }
7141   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7142   PetscFunctionReturn(0);
7143 }
7144 
7145 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7146 {
7147   PetscInt       i,j;
7148   PetscScalar    *alphas;
7149   PetscReal      norm;
7150   PetscErrorCode ierr;
7151 
7152   PetscFunctionBegin;
7153   if (!n) PetscFunctionReturn(0);
7154   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7155   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7156   if (norm < PETSC_SMALL) {
7157     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7158   }
7159   for (i=1;i<n;i++) {
7160     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7161     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7162     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7163     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7164     if (norm < PETSC_SMALL) {
7165       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7166     }
7167   }
7168   ierr = PetscFree(alphas);CHKERRQ(ierr);
7169   PetscFunctionReturn(0);
7170 }
7171 
7172 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7173 {
7174   Mat            A;
7175   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7176   PetscMPIInt    size,rank,color;
7177   PetscInt       *xadj,*adjncy;
7178   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7179   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7180   PetscInt       void_procs,*procs_candidates = NULL;
7181   PetscInt       xadj_count,*count;
7182   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7183   PetscSubcomm   psubcomm;
7184   MPI_Comm       subcomm;
7185   PetscErrorCode ierr;
7186 
7187   PetscFunctionBegin;
7188   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7189   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7190   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);
7191   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7192   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7193   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7194 
7195   if (have_void) *have_void = PETSC_FALSE;
7196   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7197   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7198   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7199   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7200   im_active = !!n;
7201   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7202   void_procs = size - active_procs;
7203   /* get ranks of of non-active processes in mat communicator */
7204   if (void_procs) {
7205     PetscInt ncand;
7206 
7207     if (have_void) *have_void = PETSC_TRUE;
7208     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7209     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7210     for (i=0,ncand=0;i<size;i++) {
7211       if (!procs_candidates[i]) {
7212         procs_candidates[ncand++] = i;
7213       }
7214     }
7215     /* force n_subdomains to be not greater that the number of non-active processes */
7216     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7217   }
7218 
7219   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7220      number of subdomains requested 1 -> send to master or first candidate in voids  */
7221   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7222   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7223     PetscInt issize,isidx,dest;
7224     if (*n_subdomains == 1) dest = 0;
7225     else dest = rank;
7226     if (im_active) {
7227       issize = 1;
7228       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7229         isidx = procs_candidates[dest];
7230       } else {
7231         isidx = dest;
7232       }
7233     } else {
7234       issize = 0;
7235       isidx = -1;
7236     }
7237     if (*n_subdomains != 1) *n_subdomains = active_procs;
7238     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7239     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7240     PetscFunctionReturn(0);
7241   }
7242   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7243   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7244   threshold = PetscMax(threshold,2);
7245 
7246   /* Get info on mapping */
7247   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7248 
7249   /* build local CSR graph of subdomains' connectivity */
7250   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7251   xadj[0] = 0;
7252   xadj[1] = PetscMax(n_neighs-1,0);
7253   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7254   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7255   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7256   for (i=1;i<n_neighs;i++)
7257     for (j=0;j<n_shared[i];j++)
7258       count[shared[i][j]] += 1;
7259 
7260   xadj_count = 0;
7261   for (i=1;i<n_neighs;i++) {
7262     for (j=0;j<n_shared[i];j++) {
7263       if (count[shared[i][j]] < threshold) {
7264         adjncy[xadj_count] = neighs[i];
7265         adjncy_wgt[xadj_count] = n_shared[i];
7266         xadj_count++;
7267         break;
7268       }
7269     }
7270   }
7271   xadj[1] = xadj_count;
7272   ierr = PetscFree(count);CHKERRQ(ierr);
7273   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7274   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7275 
7276   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7277 
7278   /* Restrict work on active processes only */
7279   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7280   if (void_procs) {
7281     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7282     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7283     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7284     subcomm = PetscSubcommChild(psubcomm);
7285   } else {
7286     psubcomm = NULL;
7287     subcomm = PetscObjectComm((PetscObject)mat);
7288   }
7289 
7290   v_wgt = NULL;
7291   if (!color) {
7292     ierr = PetscFree(xadj);CHKERRQ(ierr);
7293     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7294     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7295   } else {
7296     Mat             subdomain_adj;
7297     IS              new_ranks,new_ranks_contig;
7298     MatPartitioning partitioner;
7299     PetscInt        rstart=0,rend=0;
7300     PetscInt        *is_indices,*oldranks;
7301     PetscMPIInt     size;
7302     PetscBool       aggregate;
7303 
7304     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7305     if (void_procs) {
7306       PetscInt prank = rank;
7307       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7308       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7309       for (i=0;i<xadj[1];i++) {
7310         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7311       }
7312       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7313     } else {
7314       oldranks = NULL;
7315     }
7316     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7317     if (aggregate) { /* TODO: all this part could be made more efficient */
7318       PetscInt    lrows,row,ncols,*cols;
7319       PetscMPIInt nrank;
7320       PetscScalar *vals;
7321 
7322       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7323       lrows = 0;
7324       if (nrank<redprocs) {
7325         lrows = size/redprocs;
7326         if (nrank<size%redprocs) lrows++;
7327       }
7328       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7329       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7330       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7331       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7332       row = nrank;
7333       ncols = xadj[1]-xadj[0];
7334       cols = adjncy;
7335       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7336       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7337       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7338       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7339       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7340       ierr = PetscFree(xadj);CHKERRQ(ierr);
7341       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7342       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7343       ierr = PetscFree(vals);CHKERRQ(ierr);
7344       if (use_vwgt) {
7345         Vec               v;
7346         const PetscScalar *array;
7347         PetscInt          nl;
7348 
7349         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7350         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7351         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7352         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7353         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7354         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7355         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7356         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7357         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7358         ierr = VecDestroy(&v);CHKERRQ(ierr);
7359       }
7360     } else {
7361       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7362       if (use_vwgt) {
7363         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7364         v_wgt[0] = n;
7365       }
7366     }
7367     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7368 
7369     /* Partition */
7370     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7371 #if defined(PETSC_HAVE_PTSCOTCH)
7372     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7373 #elif defined(PETSC_HAVE_PARMETIS)
7374     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7375 #else
7376     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7377 #endif
7378     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7379     if (v_wgt) {
7380       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7381     }
7382     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7383     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7384     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7385     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7386     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7387 
7388     /* renumber new_ranks to avoid "holes" in new set of processors */
7389     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7390     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7391     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7392     if (!aggregate) {
7393       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7394 #if defined(PETSC_USE_DEBUG)
7395         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7396 #endif
7397         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7398       } else if (oldranks) {
7399         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7400       } else {
7401         ranks_send_to_idx[0] = is_indices[0];
7402       }
7403     } else {
7404       PetscInt    idx = 0;
7405       PetscMPIInt tag;
7406       MPI_Request *reqs;
7407 
7408       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7409       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7410       for (i=rstart;i<rend;i++) {
7411         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7412       }
7413       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7414       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7415       ierr = PetscFree(reqs);CHKERRQ(ierr);
7416       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7417 #if defined(PETSC_USE_DEBUG)
7418         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7419 #endif
7420         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7421       } else if (oldranks) {
7422         ranks_send_to_idx[0] = oldranks[idx];
7423       } else {
7424         ranks_send_to_idx[0] = idx;
7425       }
7426     }
7427     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7428     /* clean up */
7429     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7430     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7431     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7432     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7433   }
7434   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7435   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7436 
7437   /* assemble parallel IS for sends */
7438   i = 1;
7439   if (!color) i=0;
7440   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7441   PetscFunctionReturn(0);
7442 }
7443 
7444 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7445 
7446 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[])
7447 {
7448   Mat                    local_mat;
7449   IS                     is_sends_internal;
7450   PetscInt               rows,cols,new_local_rows;
7451   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7452   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7453   ISLocalToGlobalMapping l2gmap;
7454   PetscInt*              l2gmap_indices;
7455   const PetscInt*        is_indices;
7456   MatType                new_local_type;
7457   /* buffers */
7458   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7459   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7460   PetscInt               *recv_buffer_idxs_local;
7461   PetscScalar            *ptr_vals,*recv_buffer_vals;
7462   const PetscScalar      *send_buffer_vals;
7463   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7464   /* MPI */
7465   MPI_Comm               comm,comm_n;
7466   PetscSubcomm           subcomm;
7467   PetscMPIInt            n_sends,n_recvs,size;
7468   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7469   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7470   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7471   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7472   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7473   PetscErrorCode         ierr;
7474 
7475   PetscFunctionBegin;
7476   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7477   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7478   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);
7479   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7480   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7481   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7482   PetscValidLogicalCollectiveBool(mat,reuse,6);
7483   PetscValidLogicalCollectiveInt(mat,nis,8);
7484   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7485   if (nvecs) {
7486     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7487     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7488   }
7489   /* further checks */
7490   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7491   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7492   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7493   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7494   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7495   if (reuse && *mat_n) {
7496     PetscInt mrows,mcols,mnrows,mncols;
7497     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7498     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7499     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7500     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7501     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7502     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7503     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7504   }
7505   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7506   PetscValidLogicalCollectiveInt(mat,bs,0);
7507 
7508   /* prepare IS for sending if not provided */
7509   if (!is_sends) {
7510     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7511     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7512   } else {
7513     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7514     is_sends_internal = is_sends;
7515   }
7516 
7517   /* get comm */
7518   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7519 
7520   /* compute number of sends */
7521   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7522   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7523 
7524   /* compute number of receives */
7525   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7526   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7527   ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
7528   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7529   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7530   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7531   ierr = PetscFree(iflags);CHKERRQ(ierr);
7532 
7533   /* restrict comm if requested */
7534   subcomm = 0;
7535   destroy_mat = PETSC_FALSE;
7536   if (restrict_comm) {
7537     PetscMPIInt color,subcommsize;
7538 
7539     color = 0;
7540     if (restrict_full) {
7541       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7542     } else {
7543       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7544     }
7545     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7546     subcommsize = size - subcommsize;
7547     /* check if reuse has been requested */
7548     if (reuse) {
7549       if (*mat_n) {
7550         PetscMPIInt subcommsize2;
7551         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7552         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7553         comm_n = PetscObjectComm((PetscObject)*mat_n);
7554       } else {
7555         comm_n = PETSC_COMM_SELF;
7556       }
7557     } else { /* MAT_INITIAL_MATRIX */
7558       PetscMPIInt rank;
7559 
7560       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7561       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7562       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7563       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7564       comm_n = PetscSubcommChild(subcomm);
7565     }
7566     /* flag to destroy *mat_n if not significative */
7567     if (color) destroy_mat = PETSC_TRUE;
7568   } else {
7569     comm_n = comm;
7570   }
7571 
7572   /* prepare send/receive buffers */
7573   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7574   ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7575   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7576   ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr);
7577   if (nis) {
7578     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7579   }
7580 
7581   /* Get data from local matrices */
7582   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7583     /* TODO: See below some guidelines on how to prepare the local buffers */
7584     /*
7585        send_buffer_vals should contain the raw values of the local matrix
7586        send_buffer_idxs should contain:
7587        - MatType_PRIVATE type
7588        - PetscInt        size_of_l2gmap
7589        - PetscInt        global_row_indices[size_of_l2gmap]
7590        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7591     */
7592   else {
7593     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7594     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7595     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7596     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7597     send_buffer_idxs[1] = i;
7598     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7599     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7600     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7601     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7602     for (i=0;i<n_sends;i++) {
7603       ilengths_vals[is_indices[i]] = len*len;
7604       ilengths_idxs[is_indices[i]] = len+2;
7605     }
7606   }
7607   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7608   /* additional is (if any) */
7609   if (nis) {
7610     PetscMPIInt psum;
7611     PetscInt j;
7612     for (j=0,psum=0;j<nis;j++) {
7613       PetscInt plen;
7614       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7615       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7616       psum += len+1; /* indices + lenght */
7617     }
7618     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7619     for (j=0,psum=0;j<nis;j++) {
7620       PetscInt plen;
7621       const PetscInt *is_array_idxs;
7622       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7623       send_buffer_idxs_is[psum] = plen;
7624       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7625       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7626       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7627       psum += plen+1; /* indices + lenght */
7628     }
7629     for (i=0;i<n_sends;i++) {
7630       ilengths_idxs_is[is_indices[i]] = psum;
7631     }
7632     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7633   }
7634   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7635 
7636   buf_size_idxs = 0;
7637   buf_size_vals = 0;
7638   buf_size_idxs_is = 0;
7639   buf_size_vecs = 0;
7640   for (i=0;i<n_recvs;i++) {
7641     buf_size_idxs += (PetscInt)olengths_idxs[i];
7642     buf_size_vals += (PetscInt)olengths_vals[i];
7643     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7644     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7645   }
7646   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7647   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7648   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7649   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7650 
7651   /* get new tags for clean communications */
7652   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7653   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7654   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7655   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7656 
7657   /* allocate for requests */
7658   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7659   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7660   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7661   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7662   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7663   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7664   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7665   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7666 
7667   /* communications */
7668   ptr_idxs = recv_buffer_idxs;
7669   ptr_vals = recv_buffer_vals;
7670   ptr_idxs_is = recv_buffer_idxs_is;
7671   ptr_vecs = recv_buffer_vecs;
7672   for (i=0;i<n_recvs;i++) {
7673     source_dest = onodes[i];
7674     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7675     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7676     ptr_idxs += olengths_idxs[i];
7677     ptr_vals += olengths_vals[i];
7678     if (nis) {
7679       source_dest = onodes_is[i];
7680       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);
7681       ptr_idxs_is += olengths_idxs_is[i];
7682     }
7683     if (nvecs) {
7684       source_dest = onodes[i];
7685       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7686       ptr_vecs += olengths_idxs[i]-2;
7687     }
7688   }
7689   for (i=0;i<n_sends;i++) {
7690     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7691     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7692     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7693     if (nis) {
7694       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);
7695     }
7696     if (nvecs) {
7697       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7698       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7699     }
7700   }
7701   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7702   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7703 
7704   /* assemble new l2g map */
7705   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7706   ptr_idxs = recv_buffer_idxs;
7707   new_local_rows = 0;
7708   for (i=0;i<n_recvs;i++) {
7709     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7710     ptr_idxs += olengths_idxs[i];
7711   }
7712   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7713   ptr_idxs = recv_buffer_idxs;
7714   new_local_rows = 0;
7715   for (i=0;i<n_recvs;i++) {
7716     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7717     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7718     ptr_idxs += olengths_idxs[i];
7719   }
7720   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7721   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7722   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7723 
7724   /* infer new local matrix type from received local matrices type */
7725   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7726   /* 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) */
7727   if (n_recvs) {
7728     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7729     ptr_idxs = recv_buffer_idxs;
7730     for (i=0;i<n_recvs;i++) {
7731       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7732         new_local_type_private = MATAIJ_PRIVATE;
7733         break;
7734       }
7735       ptr_idxs += olengths_idxs[i];
7736     }
7737     switch (new_local_type_private) {
7738       case MATDENSE_PRIVATE:
7739         new_local_type = MATSEQAIJ;
7740         bs = 1;
7741         break;
7742       case MATAIJ_PRIVATE:
7743         new_local_type = MATSEQAIJ;
7744         bs = 1;
7745         break;
7746       case MATBAIJ_PRIVATE:
7747         new_local_type = MATSEQBAIJ;
7748         break;
7749       case MATSBAIJ_PRIVATE:
7750         new_local_type = MATSEQSBAIJ;
7751         break;
7752       default:
7753         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7754         break;
7755     }
7756   } else { /* by default, new_local_type is seqaij */
7757     new_local_type = MATSEQAIJ;
7758     bs = 1;
7759   }
7760 
7761   /* create MATIS object if needed */
7762   if (!reuse) {
7763     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7764     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7765   } else {
7766     /* it also destroys the local matrices */
7767     if (*mat_n) {
7768       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7769     } else { /* this is a fake object */
7770       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7771     }
7772   }
7773   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7774   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7775 
7776   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7777 
7778   /* Global to local map of received indices */
7779   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7780   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7781   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7782 
7783   /* restore attributes -> type of incoming data and its size */
7784   buf_size_idxs = 0;
7785   for (i=0;i<n_recvs;i++) {
7786     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7787     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7788     buf_size_idxs += (PetscInt)olengths_idxs[i];
7789   }
7790   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7791 
7792   /* set preallocation */
7793   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7794   if (!newisdense) {
7795     PetscInt *new_local_nnz=0;
7796 
7797     ptr_idxs = recv_buffer_idxs_local;
7798     if (n_recvs) {
7799       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7800     }
7801     for (i=0;i<n_recvs;i++) {
7802       PetscInt j;
7803       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7804         for (j=0;j<*(ptr_idxs+1);j++) {
7805           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7806         }
7807       } else {
7808         /* TODO */
7809       }
7810       ptr_idxs += olengths_idxs[i];
7811     }
7812     if (new_local_nnz) {
7813       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7814       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7815       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7816       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7817       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7818       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7819     } else {
7820       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7821     }
7822     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7823   } else {
7824     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7825   }
7826 
7827   /* set values */
7828   ptr_vals = recv_buffer_vals;
7829   ptr_idxs = recv_buffer_idxs_local;
7830   for (i=0;i<n_recvs;i++) {
7831     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7832       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7833       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7834       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7835       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7836       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7837     } else {
7838       /* TODO */
7839     }
7840     ptr_idxs += olengths_idxs[i];
7841     ptr_vals += olengths_vals[i];
7842   }
7843   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7844   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7845   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7846   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7847   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7848   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7849 
7850 #if 0
7851   if (!restrict_comm) { /* check */
7852     Vec       lvec,rvec;
7853     PetscReal infty_error;
7854 
7855     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7856     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7857     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7858     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7859     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7860     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7861     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7862     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7863     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7864   }
7865 #endif
7866 
7867   /* assemble new additional is (if any) */
7868   if (nis) {
7869     PetscInt **temp_idxs,*count_is,j,psum;
7870 
7871     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7872     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7873     ptr_idxs = recv_buffer_idxs_is;
7874     psum = 0;
7875     for (i=0;i<n_recvs;i++) {
7876       for (j=0;j<nis;j++) {
7877         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7878         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7879         psum += plen;
7880         ptr_idxs += plen+1; /* shift pointer to received data */
7881       }
7882     }
7883     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7884     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7885     for (i=1;i<nis;i++) {
7886       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7887     }
7888     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7889     ptr_idxs = recv_buffer_idxs_is;
7890     for (i=0;i<n_recvs;i++) {
7891       for (j=0;j<nis;j++) {
7892         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7893         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7894         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7895         ptr_idxs += plen+1; /* shift pointer to received data */
7896       }
7897     }
7898     for (i=0;i<nis;i++) {
7899       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7900       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7901       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7902     }
7903     ierr = PetscFree(count_is);CHKERRQ(ierr);
7904     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7905     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7906   }
7907   /* free workspace */
7908   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7909   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7910   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7911   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7912   if (isdense) {
7913     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7914     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7915     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7916   } else {
7917     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7918   }
7919   if (nis) {
7920     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7921     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7922   }
7923 
7924   if (nvecs) {
7925     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7926     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7927     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7928     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7929     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7930     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7931     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7932     /* set values */
7933     ptr_vals = recv_buffer_vecs;
7934     ptr_idxs = recv_buffer_idxs_local;
7935     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7936     for (i=0;i<n_recvs;i++) {
7937       PetscInt j;
7938       for (j=0;j<*(ptr_idxs+1);j++) {
7939         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7940       }
7941       ptr_idxs += olengths_idxs[i];
7942       ptr_vals += olengths_idxs[i]-2;
7943     }
7944     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7945     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7946     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7947   }
7948 
7949   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7950   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7951   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7952   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7953   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7954   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7955   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7956   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7957   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7958   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7959   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7960   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7961   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7962   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7963   ierr = PetscFree(onodes);CHKERRQ(ierr);
7964   if (nis) {
7965     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7966     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7967     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7968   }
7969   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7970   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7971     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7972     for (i=0;i<nis;i++) {
7973       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7974     }
7975     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7976       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7977     }
7978     *mat_n = NULL;
7979   }
7980   PetscFunctionReturn(0);
7981 }
7982 
7983 /* temporary hack into ksp private data structure */
7984 #include <petsc/private/kspimpl.h>
7985 
7986 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7987 {
7988   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7989   PC_IS                  *pcis = (PC_IS*)pc->data;
7990   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7991   Mat                    coarsedivudotp = NULL;
7992   Mat                    coarseG,t_coarse_mat_is;
7993   MatNullSpace           CoarseNullSpace = NULL;
7994   ISLocalToGlobalMapping coarse_islg;
7995   IS                     coarse_is,*isarray,corners;
7996   PetscInt               i,im_active=-1,active_procs=-1;
7997   PetscInt               nis,nisdofs,nisneu,nisvert;
7998   PetscInt               coarse_eqs_per_proc;
7999   PC                     pc_temp;
8000   PCType                 coarse_pc_type;
8001   KSPType                coarse_ksp_type;
8002   PetscBool              multilevel_requested,multilevel_allowed;
8003   PetscBool              coarse_reuse;
8004   PetscInt               ncoarse,nedcfield;
8005   PetscBool              compute_vecs = PETSC_FALSE;
8006   PetscScalar            *array;
8007   MatReuse               coarse_mat_reuse;
8008   PetscBool              restr, full_restr, have_void;
8009   PetscMPIInt            size;
8010   PetscErrorCode         ierr;
8011 
8012   PetscFunctionBegin;
8013   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8014   /* Assign global numbering to coarse dofs */
8015   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 */
8016     PetscInt ocoarse_size;
8017     compute_vecs = PETSC_TRUE;
8018 
8019     pcbddc->new_primal_space = PETSC_TRUE;
8020     ocoarse_size = pcbddc->coarse_size;
8021     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8022     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8023     /* see if we can avoid some work */
8024     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8025       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8026       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8027         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8028         coarse_reuse = PETSC_FALSE;
8029       } else { /* we can safely reuse already computed coarse matrix */
8030         coarse_reuse = PETSC_TRUE;
8031       }
8032     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8033       coarse_reuse = PETSC_FALSE;
8034     }
8035     /* reset any subassembling information */
8036     if (!coarse_reuse || pcbddc->recompute_topography) {
8037       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8038     }
8039   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8040     coarse_reuse = PETSC_TRUE;
8041   }
8042   if (coarse_reuse && pcbddc->coarse_ksp) {
8043     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8044     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8045     coarse_mat_reuse = MAT_REUSE_MATRIX;
8046   } else {
8047     coarse_mat = NULL;
8048     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8049   }
8050 
8051   /* creates temporary l2gmap and IS for coarse indexes */
8052   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8053   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8054 
8055   /* creates temporary MATIS object for coarse matrix */
8056   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8057   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);
8058   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8059   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8060   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8061   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8062 
8063   /* count "active" (i.e. with positive local size) and "void" processes */
8064   im_active = !!(pcis->n);
8065   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8066 
8067   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8068   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8069   /* full_restr : just use the receivers from the subassembling pattern */
8070   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8071   coarse_mat_is        = NULL;
8072   multilevel_allowed   = PETSC_FALSE;
8073   multilevel_requested = PETSC_FALSE;
8074   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8075   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8076   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8077   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8078   if (multilevel_requested) {
8079     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8080     restr      = PETSC_FALSE;
8081     full_restr = PETSC_FALSE;
8082   } else {
8083     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8084     restr      = PETSC_TRUE;
8085     full_restr = PETSC_TRUE;
8086   }
8087   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8088   ncoarse = PetscMax(1,ncoarse);
8089   if (!pcbddc->coarse_subassembling) {
8090     if (pcbddc->coarsening_ratio > 1) {
8091       if (multilevel_requested) {
8092         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8093       } else {
8094         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8095       }
8096     } else {
8097       PetscMPIInt rank;
8098       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8099       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8100       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8101     }
8102   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8103     PetscInt    psum;
8104     if (pcbddc->coarse_ksp) psum = 1;
8105     else psum = 0;
8106     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8107     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8108   }
8109   /* determine if we can go multilevel */
8110   if (multilevel_requested) {
8111     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8112     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8113   }
8114   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8115 
8116   /* dump subassembling pattern */
8117   if (pcbddc->dbg_flag && multilevel_allowed) {
8118     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8119   }
8120   /* compute dofs splitting and neumann boundaries for coarse dofs */
8121   nedcfield = -1;
8122   corners = NULL;
8123   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneded computations */
8124     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8125     const PetscInt         *idxs;
8126     ISLocalToGlobalMapping tmap;
8127 
8128     /* create map between primal indices (in local representative ordering) and local primal numbering */
8129     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8130     /* allocate space for temporary storage */
8131     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8132     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8133     /* allocate for IS array */
8134     nisdofs = pcbddc->n_ISForDofsLocal;
8135     if (pcbddc->nedclocal) {
8136       if (pcbddc->nedfield > -1) {
8137         nedcfield = pcbddc->nedfield;
8138       } else {
8139         nedcfield = 0;
8140         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8141         nisdofs = 1;
8142       }
8143     }
8144     nisneu = !!pcbddc->NeumannBoundariesLocal;
8145     nisvert = 0; /* nisvert is not used */
8146     nis = nisdofs + nisneu + nisvert;
8147     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8148     /* dofs splitting */
8149     for (i=0;i<nisdofs;i++) {
8150       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8151       if (nedcfield != i) {
8152         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8153         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8154         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8155         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8156       } else {
8157         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8158         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8159         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8160         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8161         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8162       }
8163       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8164       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8165       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8166     }
8167     /* neumann boundaries */
8168     if (pcbddc->NeumannBoundariesLocal) {
8169       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8170       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8171       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8172       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8173       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8174       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8175       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8176       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8177     }
8178     /* coordinates */
8179     if (pcbddc->corner_selected) {
8180       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8181       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8182       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8183       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8184       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8185       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8186       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8187       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8188       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8189     }
8190     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8191     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8192     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8193   } else {
8194     nis = 0;
8195     nisdofs = 0;
8196     nisneu = 0;
8197     nisvert = 0;
8198     isarray = NULL;
8199   }
8200   /* destroy no longer needed map */
8201   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8202 
8203   /* subassemble */
8204   if (multilevel_allowed) {
8205     Vec       vp[1];
8206     PetscInt  nvecs = 0;
8207     PetscBool reuse,reuser;
8208 
8209     if (coarse_mat) reuse = PETSC_TRUE;
8210     else reuse = PETSC_FALSE;
8211     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8212     vp[0] = NULL;
8213     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8214       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8215       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8216       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8217       nvecs = 1;
8218 
8219       if (pcbddc->divudotp) {
8220         Mat      B,loc_divudotp;
8221         Vec      v,p;
8222         IS       dummy;
8223         PetscInt np;
8224 
8225         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8226         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8227         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8228         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8229         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8230         ierr = VecSet(p,1.);CHKERRQ(ierr);
8231         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8232         ierr = VecDestroy(&p);CHKERRQ(ierr);
8233         ierr = MatDestroy(&B);CHKERRQ(ierr);
8234         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8235         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8236         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8237         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8238         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8239         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8240         ierr = VecDestroy(&v);CHKERRQ(ierr);
8241       }
8242     }
8243     if (reuser) {
8244       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8245     } else {
8246       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8247     }
8248     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8249       PetscScalar       *arraym;
8250       const PetscScalar *arrayv;
8251       PetscInt          nl;
8252       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8253       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8254       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8255       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8256       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8257       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8258       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8259       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8260     } else {
8261       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8262     }
8263   } else {
8264     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8265   }
8266   if (coarse_mat_is || coarse_mat) {
8267     if (!multilevel_allowed) {
8268       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8269     } else {
8270       Mat A;
8271 
8272       /* if this matrix is present, it means we are not reusing the coarse matrix */
8273       if (coarse_mat_is) {
8274         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8275         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8276         coarse_mat = coarse_mat_is;
8277       }
8278       /* be sure we don't have MatSeqDENSE as local mat */
8279       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8280       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8281     }
8282   }
8283   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8284   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8285 
8286   /* create local to global scatters for coarse problem */
8287   if (compute_vecs) {
8288     PetscInt lrows;
8289     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8290     if (coarse_mat) {
8291       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8292     } else {
8293       lrows = 0;
8294     }
8295     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8296     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8297     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8298     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8299     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8300   }
8301   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8302 
8303   /* set defaults for coarse KSP and PC */
8304   if (multilevel_allowed) {
8305     coarse_ksp_type = KSPRICHARDSON;
8306     coarse_pc_type  = PCBDDC;
8307   } else {
8308     coarse_ksp_type = KSPPREONLY;
8309     coarse_pc_type  = PCREDUNDANT;
8310   }
8311 
8312   /* print some info if requested */
8313   if (pcbddc->dbg_flag) {
8314     if (!multilevel_allowed) {
8315       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8316       if (multilevel_requested) {
8317         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);
8318       } else if (pcbddc->max_levels) {
8319         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8320       }
8321       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8322     }
8323   }
8324 
8325   /* communicate coarse discrete gradient */
8326   coarseG = NULL;
8327   if (pcbddc->nedcG && multilevel_allowed) {
8328     MPI_Comm ccomm;
8329     if (coarse_mat) {
8330       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8331     } else {
8332       ccomm = MPI_COMM_NULL;
8333     }
8334     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8335   }
8336 
8337   /* create the coarse KSP object only once with defaults */
8338   if (coarse_mat) {
8339     PetscBool   isredundant,isnn,isbddc;
8340     PetscViewer dbg_viewer = NULL;
8341 
8342     if (pcbddc->dbg_flag) {
8343       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8344       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8345     }
8346     if (!pcbddc->coarse_ksp) {
8347       char   prefix[256],str_level[16];
8348       size_t len;
8349 
8350       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8351       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8352       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8353       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8354       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8355       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8356       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8357       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8358       /* TODO is this logic correct? should check for coarse_mat type */
8359       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8360       /* prefix */
8361       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8362       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8363       if (!pcbddc->current_level) {
8364         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8365         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8366       } else {
8367         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8368         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8369         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8370         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8371         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8372         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8373         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8374       }
8375       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8376       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8377       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8378       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8379       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8380       /* allow user customization */
8381       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8382       /* get some info after set from options */
8383       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8384       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8385       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8386       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8387       if (multilevel_allowed && !isbddc && !isnn) {
8388         isbddc = PETSC_TRUE;
8389         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8390         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8391         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8392         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8393         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8394           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8395           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8396           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8397           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8398           pc_temp->setfromoptionscalled++;
8399         }
8400       }
8401     }
8402     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8403     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8404     if (nisdofs) {
8405       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8406       for (i=0;i<nisdofs;i++) {
8407         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8408       }
8409     }
8410     if (nisneu) {
8411       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8412       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8413     }
8414     if (nisvert) {
8415       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8416       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8417     }
8418     if (coarseG) {
8419       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8420     }
8421 
8422     /* get some info after set from options */
8423     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8424 
8425     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8426     if (isbddc && !multilevel_allowed) {
8427       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8428       isbddc = PETSC_FALSE;
8429     }
8430     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8431     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8432     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8433       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8434       isbddc = PETSC_TRUE;
8435     }
8436     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8437     if (isredundant) {
8438       KSP inner_ksp;
8439       PC  inner_pc;
8440 
8441       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8442       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8443     }
8444 
8445     /* parameters which miss an API */
8446     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8447     if (isbddc) {
8448       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8449 
8450       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8451       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8452       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8453       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8454       if (pcbddc_coarse->benign_saddle_point) {
8455         Mat                    coarsedivudotp_is;
8456         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8457         IS                     row,col;
8458         const PetscInt         *gidxs;
8459         PetscInt               n,st,M,N;
8460 
8461         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8462         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8463         st   = st-n;
8464         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8465         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8466         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8467         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8468         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8469         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8470         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8471         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8472         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8473         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8474         ierr = ISDestroy(&row);CHKERRQ(ierr);
8475         ierr = ISDestroy(&col);CHKERRQ(ierr);
8476         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8477         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8478         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8479         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8480         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8481         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8482         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8483         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8484         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8485         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8486         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8487         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8488       }
8489     }
8490 
8491     /* propagate symmetry info of coarse matrix */
8492     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8493     if (pc->pmat->symmetric_set) {
8494       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8495     }
8496     if (pc->pmat->hermitian_set) {
8497       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8498     }
8499     if (pc->pmat->spd_set) {
8500       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8501     }
8502     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8503       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8504     }
8505     /* set operators */
8506     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8507     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8508     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8509     if (pcbddc->dbg_flag) {
8510       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8511     }
8512   }
8513   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8514   ierr = PetscFree(isarray);CHKERRQ(ierr);
8515 #if 0
8516   {
8517     PetscViewer viewer;
8518     char filename[256];
8519     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8520     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8521     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8522     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8523     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8524     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8525   }
8526 #endif
8527 
8528   if (corners) {
8529     Vec            gv;
8530     IS             is;
8531     const PetscInt *idxs;
8532     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8533     PetscScalar    *coords;
8534 
8535     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8536     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8537     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8538     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8539     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8540     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8541     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8542     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8543     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8544 
8545     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8546     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8547     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8548     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8549     for (i=0;i<n;i++) {
8550       for (d=0;d<cdim;d++) {
8551         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8552       }
8553     }
8554     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8555     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8556 
8557     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8558     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8559     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8560     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8561     ierr = PetscFree(coords);CHKERRQ(ierr);
8562     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8563     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8564     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8565     if (pcbddc->coarse_ksp) {
8566       PC        coarse_pc;
8567       PetscBool isbddc;
8568 
8569       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8570       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8571       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8572         PetscReal *realcoords;
8573 
8574         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8575 #if defined(PETSC_USE_COMPLEX)
8576         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8577         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8578 #else
8579         realcoords = coords;
8580 #endif
8581         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8582 #if defined(PETSC_USE_COMPLEX)
8583         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8584 #endif
8585       }
8586     }
8587     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8588     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8589   }
8590   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8591 
8592   if (pcbddc->coarse_ksp) {
8593     Vec crhs,csol;
8594 
8595     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8596     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8597     if (!csol) {
8598       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8599     }
8600     if (!crhs) {
8601       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8602     }
8603   }
8604   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8605 
8606   /* compute null space for coarse solver if the benign trick has been requested */
8607   if (pcbddc->benign_null) {
8608 
8609     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8610     for (i=0;i<pcbddc->benign_n;i++) {
8611       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8612     }
8613     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8614     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8615     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8616     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8617     if (coarse_mat) {
8618       Vec         nullv;
8619       PetscScalar *array,*array2;
8620       PetscInt    nl;
8621 
8622       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8623       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8624       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8625       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8626       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8627       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8628       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8629       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8630       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8631       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8632     }
8633   }
8634   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8635 
8636   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8637   if (pcbddc->coarse_ksp) {
8638     PetscBool ispreonly;
8639 
8640     if (CoarseNullSpace) {
8641       PetscBool isnull;
8642       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8643       if (isnull) {
8644         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8645       }
8646       /* TODO: add local nullspaces (if any) */
8647     }
8648     /* setup coarse ksp */
8649     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8650     /* Check coarse problem if in debug mode or if solving with an iterative method */
8651     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8652     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8653       KSP       check_ksp;
8654       KSPType   check_ksp_type;
8655       PC        check_pc;
8656       Vec       check_vec,coarse_vec;
8657       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8658       PetscInt  its;
8659       PetscBool compute_eigs;
8660       PetscReal *eigs_r,*eigs_c;
8661       PetscInt  neigs;
8662       const char *prefix;
8663 
8664       /* Create ksp object suitable for estimation of extreme eigenvalues */
8665       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8666       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8667       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8668       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8669       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8670       /* prevent from setup unneeded object */
8671       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8672       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8673       if (ispreonly) {
8674         check_ksp_type = KSPPREONLY;
8675         compute_eigs = PETSC_FALSE;
8676       } else {
8677         check_ksp_type = KSPGMRES;
8678         compute_eigs = PETSC_TRUE;
8679       }
8680       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8681       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8682       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8683       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8684       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8685       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8686       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8687       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8688       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8689       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8690       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8691       /* create random vec */
8692       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8693       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8694       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8695       /* solve coarse problem */
8696       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8697       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8698       /* set eigenvalue estimation if preonly has not been requested */
8699       if (compute_eigs) {
8700         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8701         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8702         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8703         if (neigs) {
8704           lambda_max = eigs_r[neigs-1];
8705           lambda_min = eigs_r[0];
8706           if (pcbddc->use_coarse_estimates) {
8707             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8708               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8709               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8710             }
8711           }
8712         }
8713       }
8714 
8715       /* check coarse problem residual error */
8716       if (pcbddc->dbg_flag) {
8717         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8718         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8719         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8720         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8721         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8722         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8723         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8724         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8725         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8726         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8727         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8728         if (CoarseNullSpace) {
8729           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8730         }
8731         if (compute_eigs) {
8732           PetscReal          lambda_max_s,lambda_min_s;
8733           KSPConvergedReason reason;
8734           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8735           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8736           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8737           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8738           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);
8739           for (i=0;i<neigs;i++) {
8740             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8741           }
8742         }
8743         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8744         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8745       }
8746       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8747       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8748       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8749       if (compute_eigs) {
8750         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8751         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8752       }
8753     }
8754   }
8755   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8756   /* print additional info */
8757   if (pcbddc->dbg_flag) {
8758     /* waits until all processes reaches this point */
8759     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8760     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8761     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8762   }
8763 
8764   /* free memory */
8765   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8766   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8767   PetscFunctionReturn(0);
8768 }
8769 
8770 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8771 {
8772   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8773   PC_IS*         pcis = (PC_IS*)pc->data;
8774   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8775   IS             subset,subset_mult,subset_n;
8776   PetscInt       local_size,coarse_size=0;
8777   PetscInt       *local_primal_indices=NULL;
8778   const PetscInt *t_local_primal_indices;
8779   PetscErrorCode ierr;
8780 
8781   PetscFunctionBegin;
8782   /* Compute global number of coarse dofs */
8783   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8784   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8785   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8786   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8787   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8788   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8789   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8790   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8791   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8792   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);
8793   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8794   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8795   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8796   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8797   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8798 
8799   /* check numbering */
8800   if (pcbddc->dbg_flag) {
8801     PetscScalar coarsesum,*array,*array2;
8802     PetscInt    i;
8803     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8804 
8805     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8806     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8807     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8808     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8809     /* counter */
8810     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8811     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8812     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8813     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8814     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8815     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8816     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8817     for (i=0;i<pcbddc->local_primal_size;i++) {
8818       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8819     }
8820     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8821     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8822     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8823     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8824     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8825     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8826     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8827     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8828     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8829     for (i=0;i<pcis->n;i++) {
8830       if (array[i] != 0.0 && array[i] != array2[i]) {
8831         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8832         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8833         set_error = PETSC_TRUE;
8834         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8835         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);
8836       }
8837     }
8838     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8839     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8840     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8841     for (i=0;i<pcis->n;i++) {
8842       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8843     }
8844     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8845     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8846     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8847     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8848     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8849     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8850     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8851       PetscInt *gidxs;
8852 
8853       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8854       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8855       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8856       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8857       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8858       for (i=0;i<pcbddc->local_primal_size;i++) {
8859         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);
8860       }
8861       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8862       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8863     }
8864     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8865     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8866     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8867   }
8868 
8869   /* get back data */
8870   *coarse_size_n = coarse_size;
8871   *local_primal_indices_n = local_primal_indices;
8872   PetscFunctionReturn(0);
8873 }
8874 
8875 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8876 {
8877   IS             localis_t;
8878   PetscInt       i,lsize,*idxs,n;
8879   PetscScalar    *vals;
8880   PetscErrorCode ierr;
8881 
8882   PetscFunctionBegin;
8883   /* get indices in local ordering exploiting local to global map */
8884   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8885   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8886   for (i=0;i<lsize;i++) vals[i] = 1.0;
8887   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8888   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8889   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8890   if (idxs) { /* multilevel guard */
8891     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8892     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8893   }
8894   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8895   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8896   ierr = PetscFree(vals);CHKERRQ(ierr);
8897   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8898   /* now compute set in local ordering */
8899   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8900   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8901   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8902   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8903   for (i=0,lsize=0;i<n;i++) {
8904     if (PetscRealPart(vals[i]) > 0.5) {
8905       lsize++;
8906     }
8907   }
8908   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8909   for (i=0,lsize=0;i<n;i++) {
8910     if (PetscRealPart(vals[i]) > 0.5) {
8911       idxs[lsize++] = i;
8912     }
8913   }
8914   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8915   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8916   *localis = localis_t;
8917   PetscFunctionReturn(0);
8918 }
8919 
8920 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8921 {
8922   PC_IS               *pcis=(PC_IS*)pc->data;
8923   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8924   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8925   Mat                 S_j;
8926   PetscInt            *used_xadj,*used_adjncy;
8927   PetscBool           free_used_adj;
8928   PetscErrorCode      ierr;
8929 
8930   PetscFunctionBegin;
8931   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8932   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8933   free_used_adj = PETSC_FALSE;
8934   if (pcbddc->sub_schurs_layers == -1) {
8935     used_xadj = NULL;
8936     used_adjncy = NULL;
8937   } else {
8938     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8939       used_xadj = pcbddc->mat_graph->xadj;
8940       used_adjncy = pcbddc->mat_graph->adjncy;
8941     } else if (pcbddc->computed_rowadj) {
8942       used_xadj = pcbddc->mat_graph->xadj;
8943       used_adjncy = pcbddc->mat_graph->adjncy;
8944     } else {
8945       PetscBool      flg_row=PETSC_FALSE;
8946       const PetscInt *xadj,*adjncy;
8947       PetscInt       nvtxs;
8948 
8949       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8950       if (flg_row) {
8951         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8952         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8953         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8954         free_used_adj = PETSC_TRUE;
8955       } else {
8956         pcbddc->sub_schurs_layers = -1;
8957         used_xadj = NULL;
8958         used_adjncy = NULL;
8959       }
8960       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8961     }
8962   }
8963 
8964   /* setup sub_schurs data */
8965   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8966   if (!sub_schurs->schur_explicit) {
8967     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8968     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8969     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);
8970   } else {
8971     Mat       change = NULL;
8972     Vec       scaling = NULL;
8973     IS        change_primal = NULL, iP;
8974     PetscInt  benign_n;
8975     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8976     PetscBool isseqaij,need_change = PETSC_FALSE;
8977     PetscBool discrete_harmonic = PETSC_FALSE;
8978 
8979     if (!pcbddc->use_vertices && reuse_solvers) {
8980       PetscInt n_vertices;
8981 
8982       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8983       reuse_solvers = (PetscBool)!n_vertices;
8984     }
8985     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8986     if (!isseqaij) {
8987       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8988       if (matis->A == pcbddc->local_mat) {
8989         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8990         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8991       } else {
8992         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8993       }
8994     }
8995     if (!pcbddc->benign_change_explicit) {
8996       benign_n = pcbddc->benign_n;
8997     } else {
8998       benign_n = 0;
8999     }
9000     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9001        We need a global reduction to avoid possible deadlocks.
9002        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9003     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9004       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9005       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9006       need_change = (PetscBool)(!need_change);
9007     }
9008     /* If the user defines additional constraints, we import them here.
9009        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 */
9010     if (need_change) {
9011       PC_IS   *pcisf;
9012       PC_BDDC *pcbddcf;
9013       PC      pcf;
9014 
9015       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9016       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9017       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9018       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9019 
9020       /* hacks */
9021       pcisf                        = (PC_IS*)pcf->data;
9022       pcisf->is_B_local            = pcis->is_B_local;
9023       pcisf->vec1_N                = pcis->vec1_N;
9024       pcisf->BtoNmap               = pcis->BtoNmap;
9025       pcisf->n                     = pcis->n;
9026       pcisf->n_B                   = pcis->n_B;
9027       pcbddcf                      = (PC_BDDC*)pcf->data;
9028       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9029       pcbddcf->mat_graph           = pcbddc->mat_graph;
9030       pcbddcf->use_faces           = PETSC_TRUE;
9031       pcbddcf->use_change_of_basis = PETSC_TRUE;
9032       pcbddcf->use_change_on_faces = PETSC_TRUE;
9033       pcbddcf->use_qr_single       = PETSC_TRUE;
9034       pcbddcf->fake_change         = PETSC_TRUE;
9035 
9036       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9037       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9038       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9039       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9040       change = pcbddcf->ConstraintMatrix;
9041       pcbddcf->ConstraintMatrix = NULL;
9042 
9043       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9044       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9045       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9046       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9047       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9048       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9049       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9050       pcf->ops->destroy = NULL;
9051       pcf->ops->reset   = NULL;
9052       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9053     }
9054     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9055 
9056     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9057     if (iP) {
9058       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9059       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9060       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9061     }
9062     if (discrete_harmonic) {
9063       Mat A;
9064       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9065       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9066       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9067       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);
9068       ierr = MatDestroy(&A);CHKERRQ(ierr);
9069     } else {
9070       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);
9071     }
9072     ierr = MatDestroy(&change);CHKERRQ(ierr);
9073     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9074   }
9075   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9076 
9077   /* free adjacency */
9078   if (free_used_adj) {
9079     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9080   }
9081   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9082   PetscFunctionReturn(0);
9083 }
9084 
9085 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9086 {
9087   PC_IS               *pcis=(PC_IS*)pc->data;
9088   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9089   PCBDDCGraph         graph;
9090   PetscErrorCode      ierr;
9091 
9092   PetscFunctionBegin;
9093   /* attach interface graph for determining subsets */
9094   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9095     IS       verticesIS,verticescomm;
9096     PetscInt vsize,*idxs;
9097 
9098     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9099     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9100     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9101     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9102     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9103     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9104     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9105     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9106     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9107     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9108     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9109   } else {
9110     graph = pcbddc->mat_graph;
9111   }
9112   /* print some info */
9113   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9114     IS       vertices;
9115     PetscInt nv,nedges,nfaces;
9116     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9117     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9118     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9119     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9120     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9121     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9122     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9123     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9124     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9125     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9126     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9127   }
9128 
9129   /* sub_schurs init */
9130   if (!pcbddc->sub_schurs) {
9131     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9132   }
9133   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);
9134 
9135   /* free graph struct */
9136   if (pcbddc->sub_schurs_rebuild) {
9137     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9138   }
9139   PetscFunctionReturn(0);
9140 }
9141 
9142 PetscErrorCode PCBDDCCheckOperator(PC pc)
9143 {
9144   PC_IS               *pcis=(PC_IS*)pc->data;
9145   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9146   PetscErrorCode      ierr;
9147 
9148   PetscFunctionBegin;
9149   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9150     IS             zerodiag = NULL;
9151     Mat            S_j,B0_B=NULL;
9152     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9153     PetscScalar    *p0_check,*array,*array2;
9154     PetscReal      norm;
9155     PetscInt       i;
9156 
9157     /* B0 and B0_B */
9158     if (zerodiag) {
9159       IS       dummy;
9160 
9161       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9162       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9163       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9164       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9165     }
9166     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9167     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9168     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9169     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9170     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9171     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9172     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9173     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9174     /* S_j */
9175     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9176     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9177 
9178     /* mimic vector in \widetilde{W}_\Gamma */
9179     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9180     /* continuous in primal space */
9181     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9182     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9183     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9184     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9185     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9186     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9187     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9188     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9189     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9190     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9191     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9192     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9193     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9194     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9195 
9196     /* assemble rhs for coarse problem */
9197     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9198     /* local with Schur */
9199     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9200     if (zerodiag) {
9201       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9202       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9203       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9204       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9205     }
9206     /* sum on primal nodes the local contributions */
9207     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9208     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9209     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9210     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9211     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9212     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9213     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9214     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9215     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9216     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9217     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9218     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9219     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9220     /* scale primal nodes (BDDC sums contibutions) */
9221     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9222     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9223     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9224     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9225     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9226     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9227     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9228     /* global: \widetilde{B0}_B w_\Gamma */
9229     if (zerodiag) {
9230       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9231       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9232       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9233       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9234     }
9235     /* BDDC */
9236     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9237     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9238 
9239     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9240     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9241     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9242     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9243     for (i=0;i<pcbddc->benign_n;i++) {
9244       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);
9245     }
9246     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9247     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9248     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9249     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9250     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9251     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9252   }
9253   PetscFunctionReturn(0);
9254 }
9255 
9256 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9257 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9258 {
9259   Mat            At;
9260   IS             rows;
9261   PetscInt       rst,ren;
9262   PetscErrorCode ierr;
9263   PetscLayout    rmap;
9264 
9265   PetscFunctionBegin;
9266   rst = ren = 0;
9267   if (ccomm != MPI_COMM_NULL) {
9268     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9269     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9270     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9271     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9272     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9273   }
9274   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9275   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9276   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9277 
9278   if (ccomm != MPI_COMM_NULL) {
9279     Mat_MPIAIJ *a,*b;
9280     IS         from,to;
9281     Vec        gvec;
9282     PetscInt   lsize;
9283 
9284     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9285     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9286     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9287     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9288     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9289     a    = (Mat_MPIAIJ*)At->data;
9290     b    = (Mat_MPIAIJ*)(*B)->data;
9291     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9292     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9293     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9294     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9295     b->A = a->A;
9296     b->B = a->B;
9297 
9298     b->donotstash      = a->donotstash;
9299     b->roworiented     = a->roworiented;
9300     b->rowindices      = 0;
9301     b->rowvalues       = 0;
9302     b->getrowactive    = PETSC_FALSE;
9303 
9304     (*B)->rmap         = rmap;
9305     (*B)->factortype   = A->factortype;
9306     (*B)->assembled    = PETSC_TRUE;
9307     (*B)->insertmode   = NOT_SET_VALUES;
9308     (*B)->preallocated = PETSC_TRUE;
9309 
9310     if (a->colmap) {
9311 #if defined(PETSC_USE_CTABLE)
9312       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9313 #else
9314       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9315       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9316       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9317 #endif
9318     } else b->colmap = 0;
9319     if (a->garray) {
9320       PetscInt len;
9321       len  = a->B->cmap->n;
9322       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9323       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9324       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9325     } else b->garray = 0;
9326 
9327     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9328     b->lvec = a->lvec;
9329     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9330 
9331     /* cannot use VecScatterCopy */
9332     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9333     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9334     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9335     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9336     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9337     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9338     ierr = ISDestroy(&from);CHKERRQ(ierr);
9339     ierr = ISDestroy(&to);CHKERRQ(ierr);
9340     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9341   }
9342   ierr = MatDestroy(&At);CHKERRQ(ierr);
9343   PetscFunctionReturn(0);
9344 }
9345