xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 380bf85a10dfabaabe769bf102c98e4f6c8eb43e)
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     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   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);
224   if (pcbddc->n_ISForDofsLocal && field >= 0) {
225     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
226     nedfieldlocal = pcbddc->ISForDofsLocal[field];
227     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
228   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
229     ne            = n;
230     nedfieldlocal = NULL;
231     global        = PETSC_TRUE;
232   } else if (field == PETSC_DECIDE) {
233     PetscInt rst,ren,*idx;
234 
235     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
238     for (i=rst;i<ren;i++) {
239       PetscInt nc;
240 
241       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
242       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
243       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
244     }
245     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
248     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
249     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
250   } else {
251     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
252   }
253 
254   /* Sanity checks */
255   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
256   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
257   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);
258 
259   /* Just set primal dofs and return */
260   if (setprimal) {
261     IS       enedfieldlocal;
262     PetscInt *eidxs;
263 
264     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
265     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
266     if (nedfieldlocal) {
267       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
268       for (i=0,cum=0;i<ne;i++) {
269         if (PetscRealPart(vals[idxs[i]]) > 2.) {
270           eidxs[cum++] = idxs[i];
271         }
272       }
273       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
274     } else {
275       for (i=0,cum=0;i<ne;i++) {
276         if (PetscRealPart(vals[i]) > 2.) {
277           eidxs[cum++] = i;
278         }
279       }
280     }
281     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
282     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
283     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
284     ierr = PetscFree(eidxs);CHKERRQ(ierr);
285     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
286     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
287     PetscFunctionReturn(0);
288   }
289 
290   /* Compute some l2g maps */
291   if (nedfieldlocal) {
292     IS is;
293 
294     /* need to map from the local Nedelec field to local numbering */
295     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
296     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
297     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
298     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
300     if (global) {
301       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
302       el2g = al2g;
303     } else {
304       IS gis;
305 
306       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
307       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
308       ierr = ISDestroy(&gis);CHKERRQ(ierr);
309     }
310     ierr = ISDestroy(&is);CHKERRQ(ierr);
311   } else {
312     /* restore default */
313     pcbddc->nedfield = -1;
314     /* one ref for the destruction of al2g, one for el2g */
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     el2g = al2g;
318     fl2g = NULL;
319   }
320 
321   /* Start communication to drop connections for interior edges (for cc analysis only) */
322   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
323   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
324   if (nedfieldlocal) {
325     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
326     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
327     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
328   } else {
329     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
330   }
331   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333 
334   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
335     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
336     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
337     if (global) {
338       PetscInt rst;
339 
340       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
341       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
342         if (matis->sf_rootdata[i] < 2) {
343           matis->sf_rootdata[cum++] = i + rst;
344         }
345       }
346       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
347       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
348     } else {
349       PetscInt *tbz;
350 
351       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
352       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
355       for (i=0,cum=0;i<ne;i++)
356         if (matis->sf_leafdata[idxs[i]] == 1)
357           tbz[cum++] = i;
358       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
359       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
360       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
361       ierr = PetscFree(tbz);CHKERRQ(ierr);
362     }
363   } else { /* we need the entire G to infer the nullspace */
364     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
365     G    = pcbddc->discretegradient;
366   }
367 
368   /* Extract subdomain relevant rows of G */
369   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
370   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
371   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
372   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISDestroy(&lned);CHKERRQ(ierr);
374   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
375   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
376   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
377 
378   /* SF for nodal dofs communications */
379   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
380   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
381   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
382   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
383   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
384   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
385   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
386   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
387   i    = singular ? 2 : 1;
388   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
389 
390   /* Destroy temporary G created in MATIS format and modified G */
391   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
392   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
393   ierr = MatDestroy(&G);CHKERRQ(ierr);
394 
395   if (print) {
396     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
397     ierr = MatView(lG,NULL);CHKERRQ(ierr);
398   }
399 
400   /* Save lG for values insertion in change of basis */
401   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
402 
403   /* Analyze the edge-nodes connections (duplicate lG) */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
405   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
406   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
410   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
411   /* need to import the boundary specification to ensure the
412      proper detection of coarse edges' endpoints */
413   if (pcbddc->DirichletBoundariesLocal) {
414     IS is;
415 
416     if (fl2g) {
417       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
418     } else {
419       is = pcbddc->DirichletBoundariesLocal;
420     }
421     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
422     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
423     for (i=0;i<cum;i++) {
424       if (idxs[i] >= 0) {
425         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
426         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
427       }
428     }
429     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
430     if (fl2g) {
431       ierr = ISDestroy(&is);CHKERRQ(ierr);
432     }
433   }
434   if (pcbddc->NeumannBoundariesLocal) {
435     IS is;
436 
437     if (fl2g) {
438       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
439     } else {
440       is = pcbddc->NeumannBoundariesLocal;
441     }
442     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
443     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
444     for (i=0;i<cum;i++) {
445       if (idxs[i] >= 0) {
446         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
447       }
448     }
449     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
450     if (fl2g) {
451       ierr = ISDestroy(&is);CHKERRQ(ierr);
452     }
453   }
454 
455   /* Count neighs per dof */
456   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
458 
459   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
460      for proper detection of coarse edges' endpoints */
461   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
462   for (i=0;i<ne;i++) {
463     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
464       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
465     }
466   }
467   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
468   if (!conforming) {
469     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
470     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
471   }
472   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
473   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
474   cum  = 0;
475   for (i=0;i<ne;i++) {
476     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
477     if (!PetscBTLookup(btee,i)) {
478       marks[cum++] = i;
479       continue;
480     }
481     /* set badly connected edge dofs as primal */
482     if (!conforming) {
483       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
484         marks[cum++] = i;
485         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
486         for (j=ii[i];j<ii[i+1];j++) {
487           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
488         }
489       } else {
490         /* every edge dofs should be connected trough a certain number of nodal dofs
491            to other edge dofs belonging to coarse edges
492            - at most 2 endpoints
493            - order-1 interior nodal dofs
494            - no undefined nodal dofs (nconn < order)
495         */
496         PetscInt ends = 0,ints = 0, undef = 0;
497         for (j=ii[i];j<ii[i+1];j++) {
498           PetscInt v = jj[j],k;
499           PetscInt nconn = iit[v+1]-iit[v];
500           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
501           if (nconn > order) ends++;
502           else if (nconn == order) ints++;
503           else undef++;
504         }
505         if (undef || ends > 2 || ints != order -1) {
506           marks[cum++] = i;
507           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
508           for (j=ii[i];j<ii[i+1];j++) {
509             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
510           }
511         }
512       }
513     }
514     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
515     if (!order && ii[i+1] != ii[i]) {
516       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
517       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
518     }
519   }
520   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
521   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
522   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
523   if (!conforming) {
524     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
525     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
526   }
527   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
528 
529   /* identify splitpoints and corner candidates */
530   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
531   if (print) {
532     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
533     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
534     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
535     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
536   }
537   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
538   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
539   for (i=0;i<nv;i++) {
540     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
541     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
542     if (!order) { /* variable order */
543       PetscReal vorder = 0.;
544 
545       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
546       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
547       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
548       ord  = 1;
549     }
550 #if defined(PETSC_USE_DEBUG)
551     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);
552 #endif
553     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
554       if (PetscBTLookup(btbd,jj[j])) {
555         bdir = PETSC_TRUE;
556         break;
557       }
558       if (vc != ecount[jj[j]]) {
559         sneighs = PETSC_FALSE;
560       } else {
561         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
562         for (k=0;k<vc;k++) {
563           if (vn[k] != en[k]) {
564             sneighs = PETSC_FALSE;
565             break;
566           }
567         }
568       }
569     }
570     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
571       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
572       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
573     } else if (test == ord) {
574       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
575         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
576         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
577       } else {
578         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
579         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
580       }
581     }
582   }
583   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
585   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
586 
587   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
588   if (order != 1) {
589     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
590     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
591     for (i=0;i<nv;i++) {
592       if (PetscBTLookup(btvcand,i)) {
593         PetscBool found = PETSC_FALSE;
594         for (j=ii[i];j<ii[i+1] && !found;j++) {
595           PetscInt k,e = jj[j];
596           if (PetscBTLookup(bte,e)) continue;
597           for (k=iit[e];k<iit[e+1];k++) {
598             PetscInt v = jjt[k];
599             if (v != i && PetscBTLookup(btvcand,v)) {
600               found = PETSC_TRUE;
601               break;
602             }
603           }
604         }
605         if (!found) {
606           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
607           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
608         } else {
609           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
610         }
611       }
612     }
613     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
614   }
615   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
616   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
617   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
618 
619   /* Get the local G^T explicitly */
620   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
621   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
622   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
623 
624   /* Mark interior nodal dofs */
625   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
626   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
627   for (i=1;i<n_neigh;i++) {
628     for (j=0;j<n_shared[i];j++) {
629       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
630     }
631   }
632   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
633 
634   /* communicate corners and splitpoints */
635   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
636   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
638   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
639 
640   if (print) {
641     IS tbz;
642 
643     cum = 0;
644     for (i=0;i<nv;i++)
645       if (sfvleaves[i])
646         vmarks[cum++] = i;
647 
648     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
649     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
650     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
651     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
652   }
653 
654   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
655   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
657   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658 
659   /* Zero rows of lGt corresponding to identified corners
660      and interior nodal dofs */
661   cum = 0;
662   for (i=0;i<nv;i++) {
663     if (sfvleaves[i]) {
664       vmarks[cum++] = i;
665       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
666     }
667     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
668   }
669   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
670   if (print) {
671     IS tbz;
672 
673     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
674     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
675     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
676     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
677   }
678   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
679   ierr = PetscFree(vmarks);CHKERRQ(ierr);
680   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
681   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
682 
683   /* Recompute G */
684   ierr = MatDestroy(&lG);CHKERRQ(ierr);
685   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
686   if (print) {
687     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
688     ierr = MatView(lG,NULL);CHKERRQ(ierr);
689     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
690     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
691   }
692 
693   /* Get primal dofs (if any) */
694   cum = 0;
695   for (i=0;i<ne;i++) {
696     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
697   }
698   if (fl2g) {
699     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
700   }
701   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
702   if (print) {
703     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
704     ierr = ISView(primals,NULL);CHKERRQ(ierr);
705   }
706   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
707   /* TODO: what if the user passed in some of them ?  */
708   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
709   ierr = ISDestroy(&primals);CHKERRQ(ierr);
710 
711   /* Compute edge connectivity */
712   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
713   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
714   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
715   if (fl2g) {
716     PetscBT   btf;
717     PetscInt  *iia,*jja,*iiu,*jju;
718     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
719 
720     /* create CSR for all local dofs */
721     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
722     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
723       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);
724       iiu = pcbddc->mat_graph->xadj;
725       jju = pcbddc->mat_graph->adjncy;
726     } else if (pcbddc->use_local_adj) {
727       rest = PETSC_TRUE;
728       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
729     } else {
730       free   = PETSC_TRUE;
731       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
732       iiu[0] = 0;
733       for (i=0;i<n;i++) {
734         iiu[i+1] = i+1;
735         jju[i]   = -1;
736       }
737     }
738 
739     /* import sizes of CSR */
740     iia[0] = 0;
741     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
742 
743     /* overwrite entries corresponding to the Nedelec field */
744     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
745     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
746     for (i=0;i<ne;i++) {
747       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
748       iia[idxs[i]+1] = ii[i+1]-ii[i];
749     }
750 
751     /* iia in CSR */
752     for (i=0;i<n;i++) iia[i+1] += iia[i];
753 
754     /* jja in CSR */
755     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
756     for (i=0;i<n;i++)
757       if (!PetscBTLookup(btf,i))
758         for (j=0;j<iiu[i+1]-iiu[i];j++)
759           jja[iia[i]+j] = jju[iiu[i]+j];
760 
761     /* map edge dofs connectivity */
762     if (jj) {
763       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
764       for (i=0;i<ne;i++) {
765         PetscInt e = idxs[i];
766         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
767       }
768     }
769     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
770     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
771     if (rest) {
772       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
773     }
774     if (free) {
775       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
776     }
777     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
778   } else {
779     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
780   }
781 
782   /* Analyze interface for edge dofs */
783   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
784   pcbddc->mat_graph->twodim = PETSC_FALSE;
785 
786   /* Get coarse edges in the edge space */
787   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
788   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
789 
790   if (fl2g) {
791     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
792     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
793     for (i=0;i<nee;i++) {
794       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
795     }
796   } else {
797     eedges  = alleedges;
798     primals = allprimals;
799   }
800 
801   /* Mark fine edge dofs with their coarse edge id */
802   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
803   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
804   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
805   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
806   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
807   if (print) {
808     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
809     ierr = ISView(primals,NULL);CHKERRQ(ierr);
810   }
811 
812   maxsize = 0;
813   for (i=0;i<nee;i++) {
814     PetscInt size,mark = i+1;
815 
816     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
817     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
818     for (j=0;j<size;j++) marks[idxs[j]] = mark;
819     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
820     maxsize = PetscMax(maxsize,size);
821   }
822 
823   /* Find coarse edge endpoints */
824   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
825   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
826   for (i=0;i<nee;i++) {
827     PetscInt mark = i+1,size;
828 
829     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
830     if (!size && nedfieldlocal) continue;
831     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
832     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
833     if (print) {
834       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
835       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
836     }
837     for (j=0;j<size;j++) {
838       PetscInt k, ee = idxs[j];
839       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
840       for (k=ii[ee];k<ii[ee+1];k++) {
841         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
842         if (PetscBTLookup(btv,jj[k])) {
843           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
844         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
845           PetscInt  k2;
846           PetscBool corner = PETSC_FALSE;
847           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
848             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]));
849             /* it's a corner if either is connected with an edge dof belonging to a different cc or
850                if the edge dof lie on the natural part of the boundary */
851             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
852               corner = PETSC_TRUE;
853               break;
854             }
855           }
856           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
857             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
858             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
859           } else {
860             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
861           }
862         }
863       }
864     }
865     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
866   }
867   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
868   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
869   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
870 
871   /* Reset marked primal dofs */
872   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
873   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
874   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
875   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
876 
877   /* Now use the initial lG */
878   ierr = MatDestroy(&lG);CHKERRQ(ierr);
879   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
880   lG   = lGinit;
881   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
882 
883   /* Compute extended cols indices */
884   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
885   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
886   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
887   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
888   i   *= maxsize;
889   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
890   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
891   eerr = PETSC_FALSE;
892   for (i=0;i<nee;i++) {
893     PetscInt size,found = 0;
894 
895     cum  = 0;
896     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
897     if (!size && nedfieldlocal) continue;
898     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
899     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
900     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
901     for (j=0;j<size;j++) {
902       PetscInt k,ee = idxs[j];
903       for (k=ii[ee];k<ii[ee+1];k++) {
904         PetscInt vv = jj[k];
905         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
906         else if (!PetscBTLookupSet(btvc,vv)) found++;
907       }
908     }
909     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
910     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
911     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
912     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
913     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
914     /* it may happen that endpoints are not defined at this point
915        if it is the case, mark this edge for a second pass */
916     if (cum != size -1 || found != 2) {
917       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
918       if (print) {
919         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
920         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
921         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
922         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
923       }
924       eerr = PETSC_TRUE;
925     }
926   }
927   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
928   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
929   if (done) {
930     PetscInt *newprimals;
931 
932     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
933     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
934     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
935     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
936     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
937     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
938     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
939     for (i=0;i<nee;i++) {
940       PetscBool has_candidates = PETSC_FALSE;
941       if (PetscBTLookup(bter,i)) {
942         PetscInt size,mark = i+1;
943 
944         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
945         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
946         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
947         for (j=0;j<size;j++) {
948           PetscInt k,ee = idxs[j];
949           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
950           for (k=ii[ee];k<ii[ee+1];k++) {
951             /* set all candidates located on the edge as corners */
952             if (PetscBTLookup(btvcand,jj[k])) {
953               PetscInt k2,vv = jj[k];
954               has_candidates = PETSC_TRUE;
955               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
956               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
957               /* set all edge dofs connected to candidate as primals */
958               for (k2=iit[vv];k2<iit[vv+1];k2++) {
959                 if (marks[jjt[k2]] == mark) {
960                   PetscInt k3,ee2 = jjt[k2];
961                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
962                   newprimals[cum++] = ee2;
963                   /* finally set the new corners */
964                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
965                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
966                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
967                   }
968                 }
969               }
970             } else {
971               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
972             }
973           }
974         }
975         if (!has_candidates) { /* circular edge */
976           PetscInt k, ee = idxs[0],*tmarks;
977 
978           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
979           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
980           for (k=ii[ee];k<ii[ee+1];k++) {
981             PetscInt k2;
982             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
983             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
984             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
985           }
986           for (j=0;j<size;j++) {
987             if (tmarks[idxs[j]] > 1) {
988               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
989               newprimals[cum++] = idxs[j];
990             }
991           }
992           ierr = PetscFree(tmarks);CHKERRQ(ierr);
993         }
994         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
995       }
996       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
997     }
998     ierr = PetscFree(extcols);CHKERRQ(ierr);
999     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1000     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1001     if (fl2g) {
1002       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1003       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1004       for (i=0;i<nee;i++) {
1005         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1006       }
1007       ierr = PetscFree(eedges);CHKERRQ(ierr);
1008     }
1009     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1010     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1011     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1012     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1013     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1014     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1015     pcbddc->mat_graph->twodim = PETSC_FALSE;
1016     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1017     if (fl2g) {
1018       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1019       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1020       for (i=0;i<nee;i++) {
1021         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1022       }
1023     } else {
1024       eedges  = alleedges;
1025       primals = allprimals;
1026     }
1027     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1028 
1029     /* Mark again */
1030     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1031     for (i=0;i<nee;i++) {
1032       PetscInt size,mark = i+1;
1033 
1034       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1035       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1036       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1037       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1038     }
1039     if (print) {
1040       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1041       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1042     }
1043 
1044     /* Recompute extended cols */
1045     eerr = PETSC_FALSE;
1046     for (i=0;i<nee;i++) {
1047       PetscInt size;
1048 
1049       cum  = 0;
1050       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1051       if (!size && nedfieldlocal) continue;
1052       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1053       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       for (j=0;j<size;j++) {
1055         PetscInt k,ee = idxs[j];
1056         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1057       }
1058       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1059       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1060       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1061       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1062       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1063       if (cum != size -1) {
1064         if (print) {
1065           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1066           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1067           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1068           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1069         }
1070         eerr = PETSC_TRUE;
1071       }
1072     }
1073   }
1074   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1075   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1076   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1077   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1078   /* an error should not occur at this point */
1079   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1080 
1081   /* Check the number of endpoints */
1082   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1083   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1085   for (i=0;i<nee;i++) {
1086     PetscInt size, found = 0, gc[2];
1087 
1088     /* init with defaults */
1089     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1090     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1091     if (!size && nedfieldlocal) continue;
1092     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1093     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1094     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1095     for (j=0;j<size;j++) {
1096       PetscInt k,ee = idxs[j];
1097       for (k=ii[ee];k<ii[ee+1];k++) {
1098         PetscInt vv = jj[k];
1099         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1100           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1101           corners[i*2+found++] = vv;
1102         }
1103       }
1104     }
1105     if (found != 2) {
1106       PetscInt e;
1107       if (fl2g) {
1108         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1109       } else {
1110         e = idxs[0];
1111       }
1112       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1113     }
1114 
1115     /* get primal dof index on this coarse edge */
1116     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1117     if (gc[0] > gc[1]) {
1118       PetscInt swap  = corners[2*i];
1119       corners[2*i]   = corners[2*i+1];
1120       corners[2*i+1] = swap;
1121     }
1122     cedges[i] = idxs[size-1];
1123     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1124     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1125   }
1126   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1127   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1128 
1129 #if defined(PETSC_USE_DEBUG)
1130   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1131      not interfere with neighbouring coarse edges */
1132   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1133   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   for (i=0;i<nv;i++) {
1135     PetscInt emax = 0,eemax = 0;
1136 
1137     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1138     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1139     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1140     for (j=1;j<nee+1;j++) {
1141       if (emax < emarks[j]) {
1142         emax = emarks[j];
1143         eemax = j;
1144       }
1145     }
1146     /* not relevant for edges */
1147     if (!eemax) continue;
1148 
1149     for (j=ii[i];j<ii[i+1];j++) {
1150       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1151         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]);
1152       }
1153     }
1154   }
1155   ierr = PetscFree(emarks);CHKERRQ(ierr);
1156   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1157 #endif
1158 
1159   /* Compute extended rows indices for edge blocks of the change of basis */
1160   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1161   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1162   extmem *= maxsize;
1163   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1164   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1165   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1166   for (i=0;i<nv;i++) {
1167     PetscInt mark = 0,size,start;
1168 
1169     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1170     for (j=ii[i];j<ii[i+1];j++)
1171       if (marks[jj[j]] && !mark)
1172         mark = marks[jj[j]];
1173 
1174     /* not relevant */
1175     if (!mark) continue;
1176 
1177     /* import extended row */
1178     mark--;
1179     start = mark*extmem+extrowcum[mark];
1180     size = ii[i+1]-ii[i];
1181     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1182     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1183     extrowcum[mark] += size;
1184   }
1185   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1187   ierr = PetscFree(marks);CHKERRQ(ierr);
1188 
1189   /* Compress extrows */
1190   cum  = 0;
1191   for (i=0;i<nee;i++) {
1192     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1193     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1194     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1195     cum  = PetscMax(cum,size);
1196   }
1197   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1198   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1200 
1201   /* Workspace for lapack inner calls and VecSetValues */
1202   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1203 
1204   /* Create change of basis matrix (preallocation can be improved) */
1205   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1206   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1207                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1208   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1209   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1210   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1211   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1212   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1215 
1216   /* Defaults to identity */
1217   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1218   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1219   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1220   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1221 
1222   /* Create discrete gradient for the coarser level if needed */
1223   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1224   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1225   if (pcbddc->current_level < pcbddc->max_levels) {
1226     ISLocalToGlobalMapping cel2g,cvl2g;
1227     IS                     wis,gwis;
1228     PetscInt               cnv,cne;
1229 
1230     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1231     if (fl2g) {
1232       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1233     } else {
1234       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1235       pcbddc->nedclocal = wis;
1236     }
1237     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1238     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1239     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1240     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1241     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1242     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1243 
1244     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1245     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1246     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1247     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1248     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1249     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1250     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1251 
1252     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1253     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1254     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1255     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1256     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1257     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1258     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1260   }
1261   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1262 
1263 #if defined(PRINT_GDET)
1264   inc = 0;
1265   lev = pcbddc->current_level;
1266 #endif
1267 
1268   /* Insert values in the change of basis matrix */
1269   for (i=0;i<nee;i++) {
1270     Mat         Gins = NULL, GKins = NULL;
1271     IS          cornersis = NULL;
1272     PetscScalar cvals[2];
1273 
1274     if (pcbddc->nedcG) {
1275       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1276     }
1277     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1278     if (Gins && GKins) {
1279       PetscScalar    *data;
1280       const PetscInt *rows,*cols;
1281       PetscInt       nrh,nch,nrc,ncc;
1282 
1283       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1284       /* H1 */
1285       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1286       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1287       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1288       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1289       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1290       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1291       /* complement */
1292       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1293       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1294       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);
1295       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);
1296       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1297       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1298       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1299 
1300       /* coarse discrete gradient */
1301       if (pcbddc->nedcG) {
1302         PetscInt cols[2];
1303 
1304         cols[0] = 2*i;
1305         cols[1] = 2*i+1;
1306         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1307       }
1308       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1309     }
1310     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1311     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1313     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1314     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1317 
1318   /* Start assembling */
1319   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1320   if (pcbddc->nedcG) {
1321     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1322   }
1323 
1324   /* Free */
1325   if (fl2g) {
1326     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1327     for (i=0;i<nee;i++) {
1328       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1329     }
1330     ierr = PetscFree(eedges);CHKERRQ(ierr);
1331   }
1332 
1333   /* hack mat_graph with primal dofs on the coarse edges */
1334   {
1335     PCBDDCGraph graph   = pcbddc->mat_graph;
1336     PetscInt    *oqueue = graph->queue;
1337     PetscInt    *ocptr  = graph->cptr;
1338     PetscInt    ncc,*idxs;
1339 
1340     /* find first primal edge */
1341     if (pcbddc->nedclocal) {
1342       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1343     } else {
1344       if (fl2g) {
1345         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1346       }
1347       idxs = cedges;
1348     }
1349     cum = 0;
1350     while (cum < nee && cedges[cum] < 0) cum++;
1351 
1352     /* adapt connected components */
1353     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1354     graph->cptr[0] = 0;
1355     for (i=0,ncc=0;i<graph->ncc;i++) {
1356       PetscInt lc = ocptr[i+1]-ocptr[i];
1357       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1358         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1359         graph->queue[graph->cptr[ncc]] = cedges[cum];
1360         ncc++;
1361         lc--;
1362         cum++;
1363         while (cum < nee && cedges[cum] < 0) cum++;
1364       }
1365       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1366       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1367       ncc++;
1368     }
1369     graph->ncc = ncc;
1370     if (pcbddc->nedclocal) {
1371       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1372     }
1373     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1376   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1378   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1379 
1380   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1381   ierr = PetscFree(extrow);CHKERRQ(ierr);
1382   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1383   ierr = PetscFree(corners);CHKERRQ(ierr);
1384   ierr = PetscFree(cedges);CHKERRQ(ierr);
1385   ierr = PetscFree(extrows);CHKERRQ(ierr);
1386   ierr = PetscFree(extcols);CHKERRQ(ierr);
1387   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1388 
1389   /* Complete assembling */
1390   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1391   if (pcbddc->nedcG) {
1392     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1393 #if 0
1394     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1395     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1396 #endif
1397   }
1398 
1399   /* set change of basis */
1400   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1401   ierr = MatDestroy(&T);CHKERRQ(ierr);
1402 
1403   PetscFunctionReturn(0);
1404 }
1405 
1406 /* the near-null space of BDDC carries information on quadrature weights,
1407    and these can be collinear -> so cheat with MatNullSpaceCreate
1408    and create a suitable set of basis vectors first */
1409 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1410 {
1411   PetscErrorCode ierr;
1412   PetscInt       i;
1413 
1414   PetscFunctionBegin;
1415   for (i=0;i<nvecs;i++) {
1416     PetscInt first,last;
1417 
1418     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1419     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1420     if (i>=first && i < last) {
1421       PetscScalar *data;
1422       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1423       if (!has_const) {
1424         data[i-first] = 1.;
1425       } else {
1426         data[2*i-first] = 1./PetscSqrtReal(2.);
1427         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1428       }
1429       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1430     }
1431     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1432   }
1433   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1434   for (i=0;i<nvecs;i++) { /* reset vectors */
1435     PetscInt first,last;
1436     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1437     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1438     if (i>=first && i < last) {
1439       PetscScalar *data;
1440       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1441       if (!has_const) {
1442         data[i-first] = 0.;
1443       } else {
1444         data[2*i-first] = 0.;
1445         data[2*i-first+1] = 0.;
1446       }
1447       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1448     }
1449     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1450     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1451   }
1452   PetscFunctionReturn(0);
1453 }
1454 
1455 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1456 {
1457   Mat                    loc_divudotp;
1458   Vec                    p,v,vins,quad_vec,*quad_vecs;
1459   ISLocalToGlobalMapping map;
1460   PetscScalar            *vals;
1461   const PetscScalar      *array;
1462   PetscInt               i,maxneighs,maxsize,*gidxs;
1463   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1464   PetscMPIInt            rank;
1465   PetscErrorCode         ierr;
1466 
1467   PetscFunctionBegin;
1468   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1469   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1470   if (!maxneighs) {
1471     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1472     *nnsp = NULL;
1473     PetscFunctionReturn(0);
1474   }
1475   maxsize = 0;
1476   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1477   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1478   /* create vectors to hold quadrature weights */
1479   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1480   if (!transpose) {
1481     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1482   } else {
1483     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1484   }
1485   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1486   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1487   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1488   for (i=0;i<maxneighs;i++) {
1489     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1490   }
1491 
1492   /* compute local quad vec */
1493   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1494   if (!transpose) {
1495     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1496   } else {
1497     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1498   }
1499   ierr = VecSet(p,1.);CHKERRQ(ierr);
1500   if (!transpose) {
1501     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1502   } else {
1503     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1504   }
1505   if (vl2l) {
1506     Mat        lA;
1507     VecScatter sc;
1508 
1509     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1510     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1511     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1512     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1513     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1515   } else {
1516     vins = v;
1517   }
1518   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1519   ierr = VecDestroy(&p);CHKERRQ(ierr);
1520 
1521   /* insert in global quadrature vecs */
1522   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1523   for (i=0;i<n_neigh;i++) {
1524     const PetscInt    *idxs;
1525     PetscInt          idx,nn,j;
1526 
1527     idxs = shared[i];
1528     nn   = n_shared[i];
1529     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1530     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1531     idx  = -(idx+1);
1532     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1533     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1534   }
1535   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1536   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1537   if (vl2l) {
1538     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1539   }
1540   ierr = VecDestroy(&v);CHKERRQ(ierr);
1541   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1542 
1543   /* assemble near null space */
1544   for (i=0;i<maxneighs;i++) {
1545     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1546   }
1547   for (i=0;i<maxneighs;i++) {
1548     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1549     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1550     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1551   }
1552   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1553   PetscFunctionReturn(0);
1554 }
1555 
1556 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1557 {
1558   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1559   PetscErrorCode ierr;
1560 
1561   PetscFunctionBegin;
1562   if (primalv) {
1563     if (pcbddc->user_primal_vertices_local) {
1564       IS list[2], newp;
1565 
1566       list[0] = primalv;
1567       list[1] = pcbddc->user_primal_vertices_local;
1568       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1569       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1570       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1571       pcbddc->user_primal_vertices_local = newp;
1572     } else {
1573       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1574     }
1575   }
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1580 {
1581   PetscInt f, *comp  = (PetscInt *)ctx;
1582 
1583   PetscFunctionBegin;
1584   for (f=0;f<Nf;f++) out[f] = X[*comp];
1585   PetscFunctionReturn(0);
1586 }
1587 
1588 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1589 {
1590   PetscErrorCode ierr;
1591   Vec            local,global;
1592   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1593   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1594   PetscBool      monolithic = PETSC_FALSE;
1595 
1596   PetscFunctionBegin;
1597   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1598   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1599   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1600   /* need to convert from global to local topology information and remove references to information in global ordering */
1601   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1602   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1603   if (monolithic) { /* just get block size to properly compute vertices */
1604     if (pcbddc->vertex_size == 1) {
1605       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1606     }
1607     goto boundary;
1608   }
1609 
1610   if (pcbddc->user_provided_isfordofs) {
1611     if (pcbddc->n_ISForDofs) {
1612       PetscInt i;
1613 
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         PetscInt bs;
1617 
1618         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1619         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1620         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1621         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1622       }
1623       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1624       pcbddc->n_ISForDofs = 0;
1625       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1626     }
1627   } else {
1628     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1629       DM dm;
1630 
1631       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1632       if (!dm) {
1633         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1634       }
1635       if (dm) {
1636         IS      *fields;
1637         PetscInt nf,i;
1638 
1639         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1640         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1641         for (i=0;i<nf;i++) {
1642           PetscInt bs;
1643 
1644           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1645           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1646           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1647           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1648         }
1649         ierr = PetscFree(fields);CHKERRQ(ierr);
1650         pcbddc->n_ISForDofsLocal = nf;
1651       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1652         PetscContainer   c;
1653 
1654         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1655         if (c) {
1656           MatISLocalFields lf;
1657           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1658           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1659         } else { /* fallback, create the default fields if bs > 1 */
1660           PetscInt i, n = matis->A->rmap->n;
1661           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1662           if (i > 1) {
1663             pcbddc->n_ISForDofsLocal = i;
1664             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1665             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1666               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1667             }
1668           }
1669         }
1670       }
1671     } else {
1672       PetscInt i;
1673       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1674         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1675       }
1676     }
1677   }
1678 
1679 boundary:
1680   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1681     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1682   } else if (pcbddc->DirichletBoundariesLocal) {
1683     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1684   }
1685   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1686     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1687   } else if (pcbddc->NeumannBoundariesLocal) {
1688     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1689   }
1690   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1691     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1692   }
1693   ierr = VecDestroy(&global);CHKERRQ(ierr);
1694   ierr = VecDestroy(&local);CHKERRQ(ierr);
1695   /* detect local disconnected subdomains if requested (use matis->A) */
1696   if (pcbddc->detect_disconnected) {
1697     IS        primalv = NULL;
1698     PetscInt  i;
1699     PetscBool filter = pcbddc->detect_disconnected_filter;
1700 
1701     for (i=0;i<pcbddc->n_local_subs;i++) {
1702       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1703     }
1704     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1705     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1706     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1707     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1708   }
1709   /* early stage corner detection */
1710   {
1711     DM dm;
1712 
1713     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1714     if (!dm) {
1715       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1716     }
1717     if (dm) {
1718       PetscBool isda;
1719 
1720       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1721       if (isda) {
1722         ISLocalToGlobalMapping l2l;
1723         IS                     corners;
1724         Mat                    lA;
1725         PetscBool              gl,lo;
1726 
1727         {
1728           Vec               cvec;
1729           const PetscScalar *coords;
1730           PetscInt          dof,n,cdim;
1731           PetscBool         memc = PETSC_TRUE;
1732 
1733           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1734           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1735           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1736           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1737           n   /= cdim;
1738           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1739           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1740           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1741 #if defined(PETSC_USE_COMPLEX)
1742           memc = PETSC_FALSE;
1743 #endif
1744           if (dof != 1) memc = PETSC_FALSE;
1745           if (memc) {
1746             ierr = PetscMemcpy(pcbddc->mat_graph->coords,coords,cdim*n*dof*sizeof(PetscReal));CHKERRQ(ierr);
1747           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1748             PetscReal *bcoords = pcbddc->mat_graph->coords;
1749             PetscInt  i, b, d;
1750 
1751             for (i=0;i<n;i++) {
1752               for (b=0;b<dof;b++) {
1753                 for (d=0;d<cdim;d++) {
1754                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1755                 }
1756               }
1757             }
1758           }
1759           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1760           pcbddc->mat_graph->cdim  = cdim;
1761           pcbddc->mat_graph->cnloc = dof*n;
1762           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1763         }
1764         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1765         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1766         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1767         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1768         lo   = (PetscBool)(l2l && corners);
1769         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1770         if (gl) { /* From PETSc's DMDA */
1771           const PetscInt    *idx;
1772           PetscInt          dof,bs,*idxout,n;
1773 
1774           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1775           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1776           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1777           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1778           if (bs == dof) {
1779             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1780             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1781           } else { /* the original DMDA local-to-local map have been modified */
1782             PetscInt i,d;
1783 
1784             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1785             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1786             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1787 
1788             bs = 1;
1789             n *= dof;
1790           }
1791           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1792           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1793           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1794           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1795           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1796           pcbddc->corner_selected  = PETSC_TRUE;
1797           pcbddc->corner_selection = PETSC_TRUE;
1798         }
1799         if (corners) {
1800           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1801         }
1802       }
1803     }
1804   }
1805   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1806     DM dm;
1807 
1808     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1809     if (!dm) {
1810       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1811     }
1812     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1813       Vec            vcoords;
1814       PetscSection   section;
1815       PetscReal      *coords;
1816       PetscInt       d,cdim,nl,nf,**ctxs;
1817       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1818 
1819       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1820       ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
1821       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1822       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1823       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1824       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1825       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1826       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1827       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1828       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1829       for (d=0;d<cdim;d++) {
1830         PetscInt          i;
1831         const PetscScalar *v;
1832 
1833         for (i=0;i<nf;i++) ctxs[i][0] = d;
1834         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1835         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1836         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1837         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1838       }
1839       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1840       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1841       ierr = PetscFree(coords);CHKERRQ(ierr);
1842       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1843       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1844     }
1845   }
1846   PetscFunctionReturn(0);
1847 }
1848 
1849 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1850 {
1851   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1852   PetscErrorCode  ierr;
1853   IS              nis;
1854   const PetscInt  *idxs;
1855   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1856   PetscBool       *ld;
1857 
1858   PetscFunctionBegin;
1859   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1860   if (mop == MPI_LAND) {
1861     /* init rootdata with true */
1862     ld   = (PetscBool*) matis->sf_rootdata;
1863     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1864   } else {
1865     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1866   }
1867   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1868   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1869   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1870   ld   = (PetscBool*) matis->sf_leafdata;
1871   for (i=0;i<nd;i++)
1872     if (-1 < idxs[i] && idxs[i] < n)
1873       ld[idxs[i]] = PETSC_TRUE;
1874   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1875   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1876   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1877   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1878   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1879   if (mop == MPI_LAND) {
1880     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1881   } else {
1882     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1883   }
1884   for (i=0,nnd=0;i<n;i++)
1885     if (ld[i])
1886       nidxs[nnd++] = i;
1887   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1888   ierr = ISDestroy(is);CHKERRQ(ierr);
1889   *is  = nis;
1890   PetscFunctionReturn(0);
1891 }
1892 
1893 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1894 {
1895   PC_IS             *pcis = (PC_IS*)(pc->data);
1896   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1897   PetscErrorCode    ierr;
1898 
1899   PetscFunctionBegin;
1900   if (!pcbddc->benign_have_null) {
1901     PetscFunctionReturn(0);
1902   }
1903   if (pcbddc->ChangeOfBasisMatrix) {
1904     Vec swap;
1905 
1906     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1907     swap = pcbddc->work_change;
1908     pcbddc->work_change = r;
1909     r = swap;
1910   }
1911   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1912   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1913   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1914   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1915   ierr = VecSet(z,0.);CHKERRQ(ierr);
1916   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1917   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1918   if (pcbddc->ChangeOfBasisMatrix) {
1919     pcbddc->work_change = r;
1920     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1921     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1922   }
1923   PetscFunctionReturn(0);
1924 }
1925 
1926 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1927 {
1928   PCBDDCBenignMatMult_ctx ctx;
1929   PetscErrorCode          ierr;
1930   PetscBool               apply_right,apply_left,reset_x;
1931 
1932   PetscFunctionBegin;
1933   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1934   if (transpose) {
1935     apply_right = ctx->apply_left;
1936     apply_left = ctx->apply_right;
1937   } else {
1938     apply_right = ctx->apply_right;
1939     apply_left = ctx->apply_left;
1940   }
1941   reset_x = PETSC_FALSE;
1942   if (apply_right) {
1943     const PetscScalar *ax;
1944     PetscInt          nl,i;
1945 
1946     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1947     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1948     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1949     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1950     for (i=0;i<ctx->benign_n;i++) {
1951       PetscScalar    sum,val;
1952       const PetscInt *idxs;
1953       PetscInt       nz,j;
1954       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1955       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1956       sum = 0.;
1957       if (ctx->apply_p0) {
1958         val = ctx->work[idxs[nz-1]];
1959         for (j=0;j<nz-1;j++) {
1960           sum += ctx->work[idxs[j]];
1961           ctx->work[idxs[j]] += val;
1962         }
1963       } else {
1964         for (j=0;j<nz-1;j++) {
1965           sum += ctx->work[idxs[j]];
1966         }
1967       }
1968       ctx->work[idxs[nz-1]] -= sum;
1969       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1970     }
1971     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1972     reset_x = PETSC_TRUE;
1973   }
1974   if (transpose) {
1975     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1976   } else {
1977     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1978   }
1979   if (reset_x) {
1980     ierr = VecResetArray(x);CHKERRQ(ierr);
1981   }
1982   if (apply_left) {
1983     PetscScalar *ay;
1984     PetscInt    i;
1985 
1986     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1987     for (i=0;i<ctx->benign_n;i++) {
1988       PetscScalar    sum,val;
1989       const PetscInt *idxs;
1990       PetscInt       nz,j;
1991       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1992       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1993       val = -ay[idxs[nz-1]];
1994       if (ctx->apply_p0) {
1995         sum = 0.;
1996         for (j=0;j<nz-1;j++) {
1997           sum += ay[idxs[j]];
1998           ay[idxs[j]] += val;
1999         }
2000         ay[idxs[nz-1]] += sum;
2001       } else {
2002         for (j=0;j<nz-1;j++) {
2003           ay[idxs[j]] += val;
2004         }
2005         ay[idxs[nz-1]] = 0.;
2006       }
2007       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2008     }
2009     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2010   }
2011   PetscFunctionReturn(0);
2012 }
2013 
2014 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2015 {
2016   PetscErrorCode ierr;
2017 
2018   PetscFunctionBegin;
2019   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2020   PetscFunctionReturn(0);
2021 }
2022 
2023 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2024 {
2025   PetscErrorCode ierr;
2026 
2027   PetscFunctionBegin;
2028   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2029   PetscFunctionReturn(0);
2030 }
2031 
2032 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2033 {
2034   PC_IS                   *pcis = (PC_IS*)pc->data;
2035   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2036   PCBDDCBenignMatMult_ctx ctx;
2037   PetscErrorCode          ierr;
2038 
2039   PetscFunctionBegin;
2040   if (!restore) {
2041     Mat                A_IB,A_BI;
2042     PetscScalar        *work;
2043     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2044 
2045     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2046     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2047     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2048     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2049     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2050     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2051     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2052     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2053     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2054     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2055     ctx->apply_left = PETSC_TRUE;
2056     ctx->apply_right = PETSC_FALSE;
2057     ctx->apply_p0 = PETSC_FALSE;
2058     ctx->benign_n = pcbddc->benign_n;
2059     if (reuse) {
2060       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2061       ctx->free = PETSC_FALSE;
2062     } else { /* TODO: could be optimized for successive solves */
2063       ISLocalToGlobalMapping N_to_D;
2064       PetscInt               i;
2065 
2066       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2067       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2068       for (i=0;i<pcbddc->benign_n;i++) {
2069         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2070       }
2071       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2072       ctx->free = PETSC_TRUE;
2073     }
2074     ctx->A = pcis->A_IB;
2075     ctx->work = work;
2076     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2077     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2078     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2079     pcis->A_IB = A_IB;
2080 
2081     /* A_BI as A_IB^T */
2082     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2083     pcbddc->benign_original_mat = pcis->A_BI;
2084     pcis->A_BI = A_BI;
2085   } else {
2086     if (!pcbddc->benign_original_mat) {
2087       PetscFunctionReturn(0);
2088     }
2089     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2090     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2091     pcis->A_IB = ctx->A;
2092     ctx->A = NULL;
2093     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2094     pcis->A_BI = pcbddc->benign_original_mat;
2095     pcbddc->benign_original_mat = NULL;
2096     if (ctx->free) {
2097       PetscInt i;
2098       for (i=0;i<ctx->benign_n;i++) {
2099         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2100       }
2101       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2102     }
2103     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2104     ierr = PetscFree(ctx);CHKERRQ(ierr);
2105   }
2106   PetscFunctionReturn(0);
2107 }
2108 
2109 /* used just in bddc debug mode */
2110 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2111 {
2112   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2113   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2114   Mat            An;
2115   PetscErrorCode ierr;
2116 
2117   PetscFunctionBegin;
2118   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2119   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2120   if (is1) {
2121     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2122     ierr = MatDestroy(&An);CHKERRQ(ierr);
2123   } else {
2124     *B = An;
2125   }
2126   PetscFunctionReturn(0);
2127 }
2128 
2129 /* TODO: add reuse flag */
2130 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2131 {
2132   Mat            Bt;
2133   PetscScalar    *a,*bdata;
2134   const PetscInt *ii,*ij;
2135   PetscInt       m,n,i,nnz,*bii,*bij;
2136   PetscBool      flg_row;
2137   PetscErrorCode ierr;
2138 
2139   PetscFunctionBegin;
2140   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2141   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2142   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2143   nnz = n;
2144   for (i=0;i<ii[n];i++) {
2145     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2146   }
2147   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2148   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2149   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2150   nnz = 0;
2151   bii[0] = 0;
2152   for (i=0;i<n;i++) {
2153     PetscInt j;
2154     for (j=ii[i];j<ii[i+1];j++) {
2155       PetscScalar entry = a[j];
2156       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2157         bij[nnz] = ij[j];
2158         bdata[nnz] = entry;
2159         nnz++;
2160       }
2161     }
2162     bii[i+1] = nnz;
2163   }
2164   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2165   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2166   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2167   {
2168     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2169     b->free_a = PETSC_TRUE;
2170     b->free_ij = PETSC_TRUE;
2171   }
2172   if (*B == A) {
2173     ierr = MatDestroy(&A);CHKERRQ(ierr);
2174   }
2175   *B = Bt;
2176   PetscFunctionReturn(0);
2177 }
2178 
2179 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2180 {
2181   Mat                    B = NULL;
2182   DM                     dm;
2183   IS                     is_dummy,*cc_n;
2184   ISLocalToGlobalMapping l2gmap_dummy;
2185   PCBDDCGraph            graph;
2186   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2187   PetscInt               i,n;
2188   PetscInt               *xadj,*adjncy;
2189   PetscBool              isplex = PETSC_FALSE;
2190   PetscErrorCode         ierr;
2191 
2192   PetscFunctionBegin;
2193   if (ncc) *ncc = 0;
2194   if (cc) *cc = NULL;
2195   if (primalv) *primalv = NULL;
2196   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2197   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2198   if (!dm) {
2199     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2200   }
2201   if (dm) {
2202     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2203   }
2204   if (filter) isplex = PETSC_FALSE;
2205 
2206   if (isplex) { /* this code has been modified from plexpartition.c */
2207     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2208     PetscInt      *adj = NULL;
2209     IS             cellNumbering;
2210     const PetscInt *cellNum;
2211     PetscBool      useCone, useClosure;
2212     PetscSection   section;
2213     PetscSegBuffer adjBuffer;
2214     PetscSF        sfPoint;
2215     PetscErrorCode ierr;
2216 
2217     PetscFunctionBegin;
2218     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2219     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2220     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2221     /* Build adjacency graph via a section/segbuffer */
2222     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2223     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2224     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2225     /* Always use FVM adjacency to create partitioner graph */
2226     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2227     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2228     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2229     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2230     for (n = 0, p = pStart; p < pEnd; p++) {
2231       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2232       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2233       adjSize = PETSC_DETERMINE;
2234       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2235       for (a = 0; a < adjSize; ++a) {
2236         const PetscInt point = adj[a];
2237         if (pStart <= point && point < pEnd) {
2238           PetscInt *PETSC_RESTRICT pBuf;
2239           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2240           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2241           *pBuf = point;
2242         }
2243       }
2244       n++;
2245     }
2246     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2247     /* Derive CSR graph from section/segbuffer */
2248     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2249     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2250     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2251     for (idx = 0, p = pStart; p < pEnd; p++) {
2252       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2253       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2254     }
2255     xadj[n] = size;
2256     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2257     /* Clean up */
2258     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2259     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2260     ierr = PetscFree(adj);CHKERRQ(ierr);
2261     graph->xadj = xadj;
2262     graph->adjncy = adjncy;
2263   } else {
2264     Mat       A;
2265     PetscBool isseqaij, flg_row;
2266 
2267     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2268     if (!A->rmap->N || !A->cmap->N) {
2269       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2270       PetscFunctionReturn(0);
2271     }
2272     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2273     if (!isseqaij && filter) {
2274       PetscBool isseqdense;
2275 
2276       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2277       if (!isseqdense) {
2278         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2279       } else { /* TODO: rectangular case and LDA */
2280         PetscScalar *array;
2281         PetscReal   chop=1.e-6;
2282 
2283         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2284         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2285         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2286         for (i=0;i<n;i++) {
2287           PetscInt j;
2288           for (j=i+1;j<n;j++) {
2289             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2290             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2291             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2292           }
2293         }
2294         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2295         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2296       }
2297     } else {
2298       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2299       B = A;
2300     }
2301     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2302 
2303     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2304     if (filter) {
2305       PetscScalar *data;
2306       PetscInt    j,cum;
2307 
2308       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2309       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2310       cum = 0;
2311       for (i=0;i<n;i++) {
2312         PetscInt t;
2313 
2314         for (j=xadj[i];j<xadj[i+1];j++) {
2315           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2316             continue;
2317           }
2318           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2319         }
2320         t = xadj_filtered[i];
2321         xadj_filtered[i] = cum;
2322         cum += t;
2323       }
2324       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2325       graph->xadj = xadj_filtered;
2326       graph->adjncy = adjncy_filtered;
2327     } else {
2328       graph->xadj = xadj;
2329       graph->adjncy = adjncy;
2330     }
2331   }
2332   /* compute local connected components using PCBDDCGraph */
2333   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2334   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2335   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2336   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2337   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2338   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2339   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2340 
2341   /* partial clean up */
2342   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2343   if (B) {
2344     PetscBool flg_row;
2345     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2346     ierr = MatDestroy(&B);CHKERRQ(ierr);
2347   }
2348   if (isplex) {
2349     ierr = PetscFree(xadj);CHKERRQ(ierr);
2350     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2351   }
2352 
2353   /* get back data */
2354   if (isplex) {
2355     if (ncc) *ncc = graph->ncc;
2356     if (cc || primalv) {
2357       Mat          A;
2358       PetscBT      btv,btvt;
2359       PetscSection subSection;
2360       PetscInt     *ids,cum,cump,*cids,*pids;
2361 
2362       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2363       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2364       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2365       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2366       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2367 
2368       cids[0] = 0;
2369       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2370         PetscInt j;
2371 
2372         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2373         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2374           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2375 
2376           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2377           for (k = 0; k < 2*size; k += 2) {
2378             PetscInt s, pp, p = closure[k], off, dof, cdof;
2379 
2380             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2381             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2382             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2383             for (s = 0; s < dof-cdof; s++) {
2384               if (PetscBTLookupSet(btvt,off+s)) continue;
2385               if (!PetscBTLookup(btv,off+s)) {
2386                 ids[cum++] = off+s;
2387               } else { /* cross-vertex */
2388                 pids[cump++] = off+s;
2389               }
2390             }
2391             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2392             if (pp != p) {
2393               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2394               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2395               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2396               for (s = 0; s < dof-cdof; s++) {
2397                 if (PetscBTLookupSet(btvt,off+s)) continue;
2398                 if (!PetscBTLookup(btv,off+s)) {
2399                   ids[cum++] = off+s;
2400                 } else { /* cross-vertex */
2401                   pids[cump++] = off+s;
2402                 }
2403               }
2404             }
2405           }
2406           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2407         }
2408         cids[i+1] = cum;
2409         /* mark dofs as already assigned */
2410         for (j = cids[i]; j < cids[i+1]; j++) {
2411           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2412         }
2413       }
2414       if (cc) {
2415         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2416         for (i = 0; i < graph->ncc; i++) {
2417           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2418         }
2419         *cc = cc_n;
2420       }
2421       if (primalv) {
2422         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2423       }
2424       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2425       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2426       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2427     }
2428   } else {
2429     if (ncc) *ncc = graph->ncc;
2430     if (cc) {
2431       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2432       for (i=0;i<graph->ncc;i++) {
2433         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);
2434       }
2435       *cc = cc_n;
2436     }
2437   }
2438   /* clean up graph */
2439   graph->xadj = 0;
2440   graph->adjncy = 0;
2441   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2442   PetscFunctionReturn(0);
2443 }
2444 
2445 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2446 {
2447   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2448   PC_IS*         pcis = (PC_IS*)(pc->data);
2449   IS             dirIS = NULL;
2450   PetscInt       i;
2451   PetscErrorCode ierr;
2452 
2453   PetscFunctionBegin;
2454   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2455   if (zerodiag) {
2456     Mat            A;
2457     Vec            vec3_N;
2458     PetscScalar    *vals;
2459     const PetscInt *idxs;
2460     PetscInt       nz,*count;
2461 
2462     /* p0 */
2463     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2464     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2465     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2466     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2467     for (i=0;i<nz;i++) vals[i] = 1.;
2468     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2469     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2470     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2471     /* v_I */
2472     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2473     for (i=0;i<nz;i++) vals[i] = 0.;
2474     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2475     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2476     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2477     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2478     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2479     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2480     if (dirIS) {
2481       PetscInt n;
2482 
2483       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2484       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2485       for (i=0;i<n;i++) vals[i] = 0.;
2486       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2487       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2488     }
2489     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2490     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2491     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2492     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2493     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2494     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2495     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2496     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]));
2497     ierr = PetscFree(vals);CHKERRQ(ierr);
2498     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2499 
2500     /* there should not be any pressure dofs lying on the interface */
2501     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2502     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2503     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2504     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2505     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2506     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]);
2507     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2508     ierr = PetscFree(count);CHKERRQ(ierr);
2509   }
2510   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2511 
2512   /* check PCBDDCBenignGetOrSetP0 */
2513   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2514   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2515   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2516   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2517   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2518   for (i=0;i<pcbddc->benign_n;i++) {
2519     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2520     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);
2521   }
2522   PetscFunctionReturn(0);
2523 }
2524 
2525 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2526 {
2527   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2528   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2529   PetscInt       nz,n,benign_n,bsp = 1;
2530   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2531   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2532   PetscErrorCode ierr;
2533 
2534   PetscFunctionBegin;
2535   if (reuse) goto project_b0;
2536   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2537   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2538   for (n=0;n<pcbddc->benign_n;n++) {
2539     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2540   }
2541   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2542   has_null_pressures = PETSC_TRUE;
2543   have_null = PETSC_TRUE;
2544   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2545      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2546      Checks if all the pressure dofs in each subdomain have a zero diagonal
2547      If not, a change of basis on pressures is not needed
2548      since the local Schur complements are already SPD
2549   */
2550   if (pcbddc->n_ISForDofsLocal) {
2551     IS        iP = NULL;
2552     PetscInt  p,*pp;
2553     PetscBool flg;
2554 
2555     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2556     n    = pcbddc->n_ISForDofsLocal;
2557     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2558     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2559     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2560     if (!flg) {
2561       n = 1;
2562       pp[0] = pcbddc->n_ISForDofsLocal-1;
2563     }
2564 
2565     bsp = 0;
2566     for (p=0;p<n;p++) {
2567       PetscInt bs;
2568 
2569       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]);
2570       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2571       bsp += bs;
2572     }
2573     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2574     bsp  = 0;
2575     for (p=0;p<n;p++) {
2576       const PetscInt *idxs;
2577       PetscInt       b,bs,npl,*bidxs;
2578 
2579       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2580       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2581       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2582       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2583       for (b=0;b<bs;b++) {
2584         PetscInt i;
2585 
2586         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2587         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2588         bsp++;
2589       }
2590       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2591       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2592     }
2593     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2594 
2595     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2596     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2597     if (iP) {
2598       IS newpressures;
2599 
2600       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2601       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2602       pressures = newpressures;
2603     }
2604     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2605     if (!sorted) {
2606       ierr = ISSort(pressures);CHKERRQ(ierr);
2607     }
2608     ierr = PetscFree(pp);CHKERRQ(ierr);
2609   }
2610 
2611   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2612   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2613   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2614   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2615   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2616   if (!sorted) {
2617     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2618   }
2619   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2620   zerodiag_save = zerodiag;
2621   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2622   if (!nz) {
2623     if (n) have_null = PETSC_FALSE;
2624     has_null_pressures = PETSC_FALSE;
2625     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2626   }
2627   recompute_zerodiag = PETSC_FALSE;
2628 
2629   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2630   zerodiag_subs    = NULL;
2631   benign_n         = 0;
2632   n_interior_dofs  = 0;
2633   interior_dofs    = NULL;
2634   nneu             = 0;
2635   if (pcbddc->NeumannBoundariesLocal) {
2636     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2637   }
2638   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2639   if (checkb) { /* need to compute interior nodes */
2640     PetscInt n,i,j;
2641     PetscInt n_neigh,*neigh,*n_shared,**shared;
2642     PetscInt *iwork;
2643 
2644     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2645     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2646     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2647     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2648     for (i=1;i<n_neigh;i++)
2649       for (j=0;j<n_shared[i];j++)
2650           iwork[shared[i][j]] += 1;
2651     for (i=0;i<n;i++)
2652       if (!iwork[i])
2653         interior_dofs[n_interior_dofs++] = i;
2654     ierr = PetscFree(iwork);CHKERRQ(ierr);
2655     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2656   }
2657   if (has_null_pressures) {
2658     IS             *subs;
2659     PetscInt       nsubs,i,j,nl;
2660     const PetscInt *idxs;
2661     PetscScalar    *array;
2662     Vec            *work;
2663     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2664 
2665     subs  = pcbddc->local_subs;
2666     nsubs = pcbddc->n_local_subs;
2667     /* 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) */
2668     if (checkb) {
2669       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2670       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2671       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2672       /* work[0] = 1_p */
2673       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2674       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2675       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2676       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2677       /* work[0] = 1_v */
2678       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2679       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2680       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2681       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2682       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2683     }
2684 
2685     if (nsubs > 1 || bsp > 1) {
2686       IS       *is;
2687       PetscInt b,totb;
2688 
2689       totb  = bsp;
2690       is    = bsp > 1 ? bzerodiag : &zerodiag;
2691       nsubs = PetscMax(nsubs,1);
2692       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2693       for (b=0;b<totb;b++) {
2694         for (i=0;i<nsubs;i++) {
2695           ISLocalToGlobalMapping l2g;
2696           IS                     t_zerodiag_subs;
2697           PetscInt               nl;
2698 
2699           if (subs) {
2700             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2701           } else {
2702             IS tis;
2703 
2704             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2705             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2706             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2707             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2708           }
2709           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2710           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2711           if (nl) {
2712             PetscBool valid = PETSC_TRUE;
2713 
2714             if (checkb) {
2715               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2716               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2717               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2718               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2719               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2720               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2721               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2722               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2723               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2724               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2725               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2726               for (j=0;j<n_interior_dofs;j++) {
2727                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2728                   valid = PETSC_FALSE;
2729                   break;
2730                 }
2731               }
2732               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2733             }
2734             if (valid && nneu) {
2735               const PetscInt *idxs;
2736               PetscInt       nzb;
2737 
2738               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2739               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2740               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2741               if (nzb) valid = PETSC_FALSE;
2742             }
2743             if (valid && pressures) {
2744               IS       t_pressure_subs,tmp;
2745               PetscInt i1,i2;
2746 
2747               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2748               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2749               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2750               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2751               if (i2 != i1) valid = PETSC_FALSE;
2752               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2753               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2754             }
2755             if (valid) {
2756               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2757               benign_n++;
2758             } else recompute_zerodiag = PETSC_TRUE;
2759           }
2760           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2761           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2762         }
2763       }
2764     } else { /* there's just one subdomain (or zero if they have not been detected */
2765       PetscBool valid = PETSC_TRUE;
2766 
2767       if (nneu) valid = PETSC_FALSE;
2768       if (valid && pressures) {
2769         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2770       }
2771       if (valid && checkb) {
2772         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2773         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2774         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2775         for (j=0;j<n_interior_dofs;j++) {
2776           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2777             valid = PETSC_FALSE;
2778             break;
2779           }
2780         }
2781         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2782       }
2783       if (valid) {
2784         benign_n = 1;
2785         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2786         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2787         zerodiag_subs[0] = zerodiag;
2788       }
2789     }
2790     if (checkb) {
2791       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2792     }
2793   }
2794   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2795 
2796   if (!benign_n) {
2797     PetscInt n;
2798 
2799     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2800     recompute_zerodiag = PETSC_FALSE;
2801     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2802     if (n) have_null = PETSC_FALSE;
2803   }
2804 
2805   /* final check for null pressures */
2806   if (zerodiag && pressures) {
2807     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2808   }
2809 
2810   if (recompute_zerodiag) {
2811     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2812     if (benign_n == 1) {
2813       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2814       zerodiag = zerodiag_subs[0];
2815     } else {
2816       PetscInt i,nzn,*new_idxs;
2817 
2818       nzn = 0;
2819       for (i=0;i<benign_n;i++) {
2820         PetscInt ns;
2821         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2822         nzn += ns;
2823       }
2824       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2825       nzn = 0;
2826       for (i=0;i<benign_n;i++) {
2827         PetscInt ns,*idxs;
2828         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2829         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2830         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2831         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2832         nzn += ns;
2833       }
2834       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2835       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2836     }
2837     have_null = PETSC_FALSE;
2838   }
2839 
2840   /* determines if the coarse solver will be singular or not */
2841   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2842 
2843   /* Prepare matrix to compute no-net-flux */
2844   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2845     Mat                    A,loc_divudotp;
2846     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2847     IS                     row,col,isused = NULL;
2848     PetscInt               M,N,n,st,n_isused;
2849 
2850     if (pressures) {
2851       isused = pressures;
2852     } else {
2853       isused = zerodiag_save;
2854     }
2855     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2856     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2857     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2858     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");
2859     n_isused = 0;
2860     if (isused) {
2861       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2862     }
2863     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2864     st = st-n_isused;
2865     if (n) {
2866       const PetscInt *gidxs;
2867 
2868       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2869       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2870       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2871       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2872       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2873       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2874     } else {
2875       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2876       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2877       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2878     }
2879     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2880     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2881     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2882     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2883     ierr = ISDestroy(&row);CHKERRQ(ierr);
2884     ierr = ISDestroy(&col);CHKERRQ(ierr);
2885     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2886     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2887     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2888     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2889     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2890     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2891     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2892     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2893     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2894     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2895   }
2896   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2897   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2898   if (bzerodiag) {
2899     PetscInt i;
2900 
2901     for (i=0;i<bsp;i++) {
2902       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2903     }
2904     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2905   }
2906   pcbddc->benign_n = benign_n;
2907   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2908 
2909   /* determines if the problem has subdomains with 0 pressure block */
2910   have_null = (PetscBool)(!!pcbddc->benign_n);
2911   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2912 
2913 project_b0:
2914   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2915   /* change of basis and p0 dofs */
2916   if (pcbddc->benign_n) {
2917     PetscInt i,s,*nnz;
2918 
2919     /* local change of basis for pressures */
2920     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2921     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2922     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2923     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2924     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2925     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2926     for (i=0;i<pcbddc->benign_n;i++) {
2927       const PetscInt *idxs;
2928       PetscInt       nzs,j;
2929 
2930       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2931       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2932       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2933       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2934       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2935     }
2936     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2937     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2938     ierr = PetscFree(nnz);CHKERRQ(ierr);
2939     /* set identity by default */
2940     for (i=0;i<n;i++) {
2941       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2942     }
2943     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2944     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2945     /* set change on pressures */
2946     for (s=0;s<pcbddc->benign_n;s++) {
2947       PetscScalar    *array;
2948       const PetscInt *idxs;
2949       PetscInt       nzs;
2950 
2951       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2952       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2953       for (i=0;i<nzs-1;i++) {
2954         PetscScalar vals[2];
2955         PetscInt    cols[2];
2956 
2957         cols[0] = idxs[i];
2958         cols[1] = idxs[nzs-1];
2959         vals[0] = 1.;
2960         vals[1] = 1.;
2961         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2962       }
2963       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2964       for (i=0;i<nzs-1;i++) array[i] = -1.;
2965       array[nzs-1] = 1.;
2966       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2967       /* store local idxs for p0 */
2968       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2969       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2970       ierr = PetscFree(array);CHKERRQ(ierr);
2971     }
2972     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2973     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2974 
2975     /* project if needed */
2976     if (pcbddc->benign_change_explicit) {
2977       Mat M;
2978 
2979       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2980       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2981       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2982       ierr = MatDestroy(&M);CHKERRQ(ierr);
2983     }
2984     /* store global idxs for p0 */
2985     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2986   }
2987   *zerodiaglocal = zerodiag;
2988   PetscFunctionReturn(0);
2989 }
2990 
2991 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2992 {
2993   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2994   PetscScalar    *array;
2995   PetscErrorCode ierr;
2996 
2997   PetscFunctionBegin;
2998   if (!pcbddc->benign_sf) {
2999     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3000     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3001   }
3002   if (get) {
3003     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3004     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3005     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3006     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3007   } else {
3008     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3009     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3010     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3011     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3012   }
3013   PetscFunctionReturn(0);
3014 }
3015 
3016 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3017 {
3018   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3019   PetscErrorCode ierr;
3020 
3021   PetscFunctionBegin;
3022   /* TODO: add error checking
3023     - avoid nested pop (or push) calls.
3024     - cannot push before pop.
3025     - cannot call this if pcbddc->local_mat is NULL
3026   */
3027   if (!pcbddc->benign_n) {
3028     PetscFunctionReturn(0);
3029   }
3030   if (pop) {
3031     if (pcbddc->benign_change_explicit) {
3032       IS       is_p0;
3033       MatReuse reuse;
3034 
3035       /* extract B_0 */
3036       reuse = MAT_INITIAL_MATRIX;
3037       if (pcbddc->benign_B0) {
3038         reuse = MAT_REUSE_MATRIX;
3039       }
3040       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3041       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3042       /* remove rows and cols from local problem */
3043       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3044       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3045       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3046       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3047     } else {
3048       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3049       PetscScalar *vals;
3050       PetscInt    i,n,*idxs_ins;
3051 
3052       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3053       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3054       if (!pcbddc->benign_B0) {
3055         PetscInt *nnz;
3056         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3057         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3058         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3059         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3060         for (i=0;i<pcbddc->benign_n;i++) {
3061           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3062           nnz[i] = n - nnz[i];
3063         }
3064         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3065         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3066         ierr = PetscFree(nnz);CHKERRQ(ierr);
3067       }
3068 
3069       for (i=0;i<pcbddc->benign_n;i++) {
3070         PetscScalar *array;
3071         PetscInt    *idxs,j,nz,cum;
3072 
3073         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3074         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3075         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3076         for (j=0;j<nz;j++) vals[j] = 1.;
3077         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3078         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3079         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3080         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3081         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3082         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3083         cum = 0;
3084         for (j=0;j<n;j++) {
3085           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3086             vals[cum] = array[j];
3087             idxs_ins[cum] = j;
3088             cum++;
3089           }
3090         }
3091         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3092         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3093         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3094       }
3095       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3096       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3097       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3098     }
3099   } else { /* push */
3100     if (pcbddc->benign_change_explicit) {
3101       PetscInt i;
3102 
3103       for (i=0;i<pcbddc->benign_n;i++) {
3104         PetscScalar *B0_vals;
3105         PetscInt    *B0_cols,B0_ncol;
3106 
3107         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3108         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3109         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3110         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3111         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3112       }
3113       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3114       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3115     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3116   }
3117   PetscFunctionReturn(0);
3118 }
3119 
3120 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3121 {
3122   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3123   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3124   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3125   PetscBLASInt    *B_iwork,*B_ifail;
3126   PetscScalar     *work,lwork;
3127   PetscScalar     *St,*S,*eigv;
3128   PetscScalar     *Sarray,*Starray;
3129   PetscReal       *eigs,thresh,lthresh,uthresh;
3130   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3131   PetscBool       allocated_S_St;
3132 #if defined(PETSC_USE_COMPLEX)
3133   PetscReal       *rwork;
3134 #endif
3135   PetscErrorCode  ierr;
3136 
3137   PetscFunctionBegin;
3138   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3139   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3140   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);
3141   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3142 
3143   if (pcbddc->dbg_flag) {
3144     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3145     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3146     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3147     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3148   }
3149 
3150   if (pcbddc->dbg_flag) {
3151     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);
3152   }
3153 
3154   /* max size of subsets */
3155   mss = 0;
3156   for (i=0;i<sub_schurs->n_subs;i++) {
3157     PetscInt subset_size;
3158 
3159     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3160     mss = PetscMax(mss,subset_size);
3161   }
3162 
3163   /* min/max and threshold */
3164   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3165   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3166   nmax = PetscMax(nmin,nmax);
3167   allocated_S_St = PETSC_FALSE;
3168   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3169     allocated_S_St = PETSC_TRUE;
3170   }
3171 
3172   /* allocate lapack workspace */
3173   cum = cum2 = 0;
3174   maxneigs = 0;
3175   for (i=0;i<sub_schurs->n_subs;i++) {
3176     PetscInt n,subset_size;
3177 
3178     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3179     n = PetscMin(subset_size,nmax);
3180     cum += subset_size;
3181     cum2 += subset_size*n;
3182     maxneigs = PetscMax(maxneigs,n);
3183   }
3184   if (mss) {
3185     if (sub_schurs->is_symmetric) {
3186       PetscBLASInt B_itype = 1;
3187       PetscBLASInt B_N = mss;
3188       PetscReal    zero = 0.0;
3189       PetscReal    eps = 0.0; /* dlamch? */
3190 
3191       B_lwork = -1;
3192       S = NULL;
3193       St = NULL;
3194       eigs = NULL;
3195       eigv = NULL;
3196       B_iwork = NULL;
3197       B_ifail = NULL;
3198 #if defined(PETSC_USE_COMPLEX)
3199       rwork = NULL;
3200 #endif
3201       thresh = 1.0;
3202       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3203 #if defined(PETSC_USE_COMPLEX)
3204       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));
3205 #else
3206       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));
3207 #endif
3208       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3209       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3210     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3211   } else {
3212     lwork = 0;
3213   }
3214 
3215   nv = 0;
3216   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) */
3217     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3218   }
3219   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3220   if (allocated_S_St) {
3221     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3222   }
3223   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3224 #if defined(PETSC_USE_COMPLEX)
3225   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3226 #endif
3227   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3228                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3229                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3230                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3231                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3232   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3233 
3234   maxneigs = 0;
3235   cum = cumarray = 0;
3236   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3237   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3238   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3239     const PetscInt *idxs;
3240 
3241     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3242     for (cum=0;cum<nv;cum++) {
3243       pcbddc->adaptive_constraints_n[cum] = 1;
3244       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3245       pcbddc->adaptive_constraints_data[cum] = 1.0;
3246       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3247       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3248     }
3249     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3250   }
3251 
3252   if (mss) { /* multilevel */
3253     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3254     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3255   }
3256 
3257   lthresh = pcbddc->adaptive_threshold[0];
3258   uthresh = pcbddc->adaptive_threshold[1];
3259   for (i=0;i<sub_schurs->n_subs;i++) {
3260     const PetscInt *idxs;
3261     PetscReal      upper,lower;
3262     PetscInt       j,subset_size,eigs_start = 0;
3263     PetscBLASInt   B_N;
3264     PetscBool      same_data = PETSC_FALSE;
3265     PetscBool      scal = PETSC_FALSE;
3266 
3267     if (pcbddc->use_deluxe_scaling) {
3268       upper = PETSC_MAX_REAL;
3269       lower = uthresh;
3270     } else {
3271       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3272       upper = 1./uthresh;
3273       lower = 0.;
3274     }
3275     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3276     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3277     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3278     /* this is experimental: we assume the dofs have been properly grouped to have
3279        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3280     if (!sub_schurs->is_posdef) {
3281       Mat T;
3282 
3283       for (j=0;j<subset_size;j++) {
3284         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3285           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3286           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3287           ierr = MatDestroy(&T);CHKERRQ(ierr);
3288           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3289           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3290           ierr = MatDestroy(&T);CHKERRQ(ierr);
3291           if (sub_schurs->change_primal_sub) {
3292             PetscInt       nz,k;
3293             const PetscInt *idxs;
3294 
3295             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3296             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3297             for (k=0;k<nz;k++) {
3298               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3299               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3300             }
3301             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3302           }
3303           scal = PETSC_TRUE;
3304           break;
3305         }
3306       }
3307     }
3308 
3309     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3310       if (sub_schurs->is_symmetric) {
3311         PetscInt j,k;
3312         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3313           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3314           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3315         }
3316         for (j=0;j<subset_size;j++) {
3317           for (k=j;k<subset_size;k++) {
3318             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3319             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3320           }
3321         }
3322       } else {
3323         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3324         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3325       }
3326     } else {
3327       S = Sarray + cumarray;
3328       St = Starray + cumarray;
3329     }
3330     /* see if we can save some work */
3331     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3332       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3333     }
3334 
3335     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3336       B_neigs = 0;
3337     } else {
3338       if (sub_schurs->is_symmetric) {
3339         PetscBLASInt B_itype = 1;
3340         PetscBLASInt B_IL, B_IU;
3341         PetscReal    eps = -1.0; /* dlamch? */
3342         PetscInt     nmin_s;
3343         PetscBool    compute_range;
3344 
3345         B_neigs = 0;
3346         compute_range = (PetscBool)!same_data;
3347         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3348 
3349         if (pcbddc->dbg_flag) {
3350           PetscInt nc = 0;
3351 
3352           if (sub_schurs->change_primal_sub) {
3353             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3354           }
3355           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);
3356         }
3357 
3358         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3359         if (compute_range) {
3360 
3361           /* ask for eigenvalues larger than thresh */
3362           if (sub_schurs->is_posdef) {
3363 #if defined(PETSC_USE_COMPLEX)
3364             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));
3365 #else
3366             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));
3367 #endif
3368             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3369           } else { /* no theory so far, but it works nicely */
3370             PetscInt  recipe = 0,recipe_m = 1;
3371             PetscReal bb[2];
3372 
3373             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3374             switch (recipe) {
3375             case 0:
3376               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3377               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3378 #if defined(PETSC_USE_COMPLEX)
3379               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));
3380 #else
3381               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));
3382 #endif
3383               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3384               break;
3385             case 1:
3386               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3387 #if defined(PETSC_USE_COMPLEX)
3388               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));
3389 #else
3390               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));
3391 #endif
3392               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3393               if (!scal) {
3394                 PetscBLASInt B_neigs2 = 0;
3395 
3396                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3397                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3398                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
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_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&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_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&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                 B_neigs += B_neigs2;
3406               }
3407               break;
3408             case 2:
3409               if (scal) {
3410                 bb[0] = PETSC_MIN_REAL;
3411                 bb[1] = 0;
3412 #if defined(PETSC_USE_COMPLEX)
3413                 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));
3414 #else
3415                 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));
3416 #endif
3417                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3418               } else {
3419                 PetscBLASInt B_neigs2 = 0;
3420                 PetscBool    import = PETSC_FALSE;
3421 
3422                 lthresh = PetscMax(lthresh,0.0);
3423                 if (lthresh > 0.0) {
3424                   bb[0] = PETSC_MIN_REAL;
3425                   bb[1] = lthresh*lthresh;
3426 
3427                   import = PETSC_TRUE;
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_neigs,eigs,eigv,&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_neigs,eigs,eigv,&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                 }
3435                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3436                 bb[1] = PETSC_MAX_REAL;
3437                 if (import) {
3438                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3439                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3440                 }
3441 #if defined(PETSC_USE_COMPLEX)
3442                 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));
3443 #else
3444                 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));
3445 #endif
3446                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3447                 B_neigs += B_neigs2;
3448               }
3449               break;
3450             case 3:
3451               if (scal) {
3452                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3453               } else {
3454                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3455               }
3456               if (!scal) {
3457                 bb[0] = uthresh;
3458                 bb[1] = PETSC_MAX_REAL;
3459 #if defined(PETSC_USE_COMPLEX)
3460                 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));
3461 #else
3462                 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));
3463 #endif
3464                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3465               }
3466               if (recipe_m > 0 && B_N - B_neigs > 0) {
3467                 PetscBLASInt B_neigs2 = 0;
3468 
3469                 B_IL = 1;
3470                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3471                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3472                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3473 #if defined(PETSC_USE_COMPLEX)
3474                 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));
3475 #else
3476                 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));
3477 #endif
3478                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3479                 B_neigs += B_neigs2;
3480               }
3481               break;
3482             case 4:
3483               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3484 #if defined(PETSC_USE_COMPLEX)
3485               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));
3486 #else
3487               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));
3488 #endif
3489               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3490               {
3491                 PetscBLASInt B_neigs2 = 0;
3492 
3493                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3494                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3495                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3496 #if defined(PETSC_USE_COMPLEX)
3497                 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));
3498 #else
3499                 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));
3500 #endif
3501                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3502                 B_neigs += B_neigs2;
3503               }
3504               break;
3505             case 5: /* same as before: first compute all eigenvalues, then filter */
3506 #if defined(PETSC_USE_COMPLEX)
3507               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));
3508 #else
3509               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));
3510 #endif
3511               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3512               {
3513                 PetscInt e,k,ne;
3514                 for (e=0,ne=0;e<B_neigs;e++) {
3515                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3516                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3517                     eigs[ne] = eigs[e];
3518                     ne++;
3519                   }
3520                 }
3521                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3522                 B_neigs = ne;
3523               }
3524               break;
3525             default:
3526               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3527               break;
3528             }
3529           }
3530         } else if (!same_data) { /* this is just to see all the eigenvalues */
3531           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3532           B_IL = 1;
3533 #if defined(PETSC_USE_COMPLEX)
3534           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));
3535 #else
3536           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));
3537 #endif
3538           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3539         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3540           PetscInt k;
3541           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3542           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3543           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3544           nmin = nmax;
3545           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3546           for (k=0;k<nmax;k++) {
3547             eigs[k] = 1./PETSC_SMALL;
3548             eigv[k*(subset_size+1)] = 1.0;
3549           }
3550         }
3551         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3552         if (B_ierr) {
3553           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3554           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);
3555           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);
3556         }
3557 
3558         if (B_neigs > nmax) {
3559           if (pcbddc->dbg_flag) {
3560             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3561           }
3562           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3563           B_neigs = nmax;
3564         }
3565 
3566         nmin_s = PetscMin(nmin,B_N);
3567         if (B_neigs < nmin_s) {
3568           PetscBLASInt B_neigs2 = 0;
3569 
3570           if (pcbddc->use_deluxe_scaling) {
3571             if (scal) {
3572               B_IU = nmin_s;
3573               B_IL = B_neigs + 1;
3574             } else {
3575               B_IL = B_N - nmin_s + 1;
3576               B_IU = B_N - B_neigs;
3577             }
3578           } else {
3579             B_IL = B_neigs + 1;
3580             B_IU = nmin_s;
3581           }
3582           if (pcbddc->dbg_flag) {
3583             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);
3584           }
3585           if (sub_schurs->is_symmetric) {
3586             PetscInt j,k;
3587             for (j=0;j<subset_size;j++) {
3588               for (k=j;k<subset_size;k++) {
3589                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3590                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3591               }
3592             }
3593           } else {
3594             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3595             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3596           }
3597           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3598 #if defined(PETSC_USE_COMPLEX)
3599           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));
3600 #else
3601           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));
3602 #endif
3603           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3604           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3605           B_neigs += B_neigs2;
3606         }
3607         if (B_ierr) {
3608           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3609           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);
3610           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);
3611         }
3612         if (pcbddc->dbg_flag) {
3613           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3614           for (j=0;j<B_neigs;j++) {
3615             if (eigs[j] == 0.0) {
3616               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3617             } else {
3618               if (pcbddc->use_deluxe_scaling) {
3619                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3620               } else {
3621                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3622               }
3623             }
3624           }
3625         }
3626       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3627     }
3628     /* change the basis back to the original one */
3629     if (sub_schurs->change) {
3630       Mat change,phi,phit;
3631 
3632       if (pcbddc->dbg_flag > 2) {
3633         PetscInt ii;
3634         for (ii=0;ii<B_neigs;ii++) {
3635           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3636           for (j=0;j<B_N;j++) {
3637 #if defined(PETSC_USE_COMPLEX)
3638             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3639             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3640             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3641 #else
3642             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3643 #endif
3644           }
3645         }
3646       }
3647       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3648       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3649       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3650       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3651       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3652       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3653     }
3654     maxneigs = PetscMax(B_neigs,maxneigs);
3655     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3656     if (B_neigs) {
3657       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);
3658 
3659       if (pcbddc->dbg_flag > 1) {
3660         PetscInt ii;
3661         for (ii=0;ii<B_neigs;ii++) {
3662           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3663           for (j=0;j<B_N;j++) {
3664 #if defined(PETSC_USE_COMPLEX)
3665             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3666             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3667             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3668 #else
3669             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3670 #endif
3671           }
3672         }
3673       }
3674       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3675       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3676       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3677       cum++;
3678     }
3679     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3680     /* shift for next computation */
3681     cumarray += subset_size*subset_size;
3682   }
3683   if (pcbddc->dbg_flag) {
3684     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3685   }
3686 
3687   if (mss) {
3688     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3689     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3690     /* destroy matrices (junk) */
3691     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3692     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3693   }
3694   if (allocated_S_St) {
3695     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3696   }
3697   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3698 #if defined(PETSC_USE_COMPLEX)
3699   ierr = PetscFree(rwork);CHKERRQ(ierr);
3700 #endif
3701   if (pcbddc->dbg_flag) {
3702     PetscInt maxneigs_r;
3703     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3704     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3705   }
3706   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3707   PetscFunctionReturn(0);
3708 }
3709 
3710 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3711 {
3712   PetscScalar    *coarse_submat_vals;
3713   PetscErrorCode ierr;
3714 
3715   PetscFunctionBegin;
3716   /* Setup local scatters R_to_B and (optionally) R_to_D */
3717   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3718   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3719 
3720   /* Setup local neumann solver ksp_R */
3721   /* PCBDDCSetUpLocalScatters should be called first! */
3722   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3723 
3724   /*
3725      Setup local correction and local part of coarse basis.
3726      Gives back the dense local part of the coarse matrix in column major ordering
3727   */
3728   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3729 
3730   /* Compute total number of coarse nodes and setup coarse solver */
3731   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3732 
3733   /* free */
3734   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3735   PetscFunctionReturn(0);
3736 }
3737 
3738 PetscErrorCode PCBDDCResetCustomization(PC pc)
3739 {
3740   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3741   PetscErrorCode ierr;
3742 
3743   PetscFunctionBegin;
3744   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3745   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3746   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3747   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3748   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3749   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3750   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3751   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3752   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3753   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3754   PetscFunctionReturn(0);
3755 }
3756 
3757 PetscErrorCode PCBDDCResetTopography(PC pc)
3758 {
3759   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3760   PetscInt       i;
3761   PetscErrorCode ierr;
3762 
3763   PetscFunctionBegin;
3764   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3765   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3766   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3767   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3768   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3769   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3770   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3771   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3772   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3773   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3774   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3775   for (i=0;i<pcbddc->n_local_subs;i++) {
3776     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3777   }
3778   pcbddc->n_local_subs = 0;
3779   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3780   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3781   pcbddc->graphanalyzed        = PETSC_FALSE;
3782   pcbddc->recompute_topography = PETSC_TRUE;
3783   pcbddc->corner_selected      = PETSC_FALSE;
3784   PetscFunctionReturn(0);
3785 }
3786 
3787 PetscErrorCode PCBDDCResetSolvers(PC pc)
3788 {
3789   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3790   PetscErrorCode ierr;
3791 
3792   PetscFunctionBegin;
3793   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3794   if (pcbddc->coarse_phi_B) {
3795     PetscScalar *array;
3796     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3797     ierr = PetscFree(array);CHKERRQ(ierr);
3798   }
3799   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3800   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3801   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3802   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3803   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3804   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3805   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3806   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3807   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3809   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3810   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3811   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3812   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3813   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3814   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3815   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3816   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3817   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3818   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3819   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3820   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3821   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3822   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3823   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3824   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3825   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3826   if (pcbddc->benign_zerodiag_subs) {
3827     PetscInt i;
3828     for (i=0;i<pcbddc->benign_n;i++) {
3829       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3830     }
3831     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3832   }
3833   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3834   PetscFunctionReturn(0);
3835 }
3836 
3837 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3838 {
3839   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3840   PC_IS          *pcis = (PC_IS*)pc->data;
3841   VecType        impVecType;
3842   PetscInt       n_constraints,n_R,old_size;
3843   PetscErrorCode ierr;
3844 
3845   PetscFunctionBegin;
3846   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3847   n_R = pcis->n - pcbddc->n_vertices;
3848   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3849   /* local work vectors (try to avoid unneeded work)*/
3850   /* R nodes */
3851   old_size = -1;
3852   if (pcbddc->vec1_R) {
3853     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3854   }
3855   if (n_R != old_size) {
3856     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3857     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3858     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3859     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3860     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3861     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3862   }
3863   /* local primal dofs */
3864   old_size = -1;
3865   if (pcbddc->vec1_P) {
3866     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3867   }
3868   if (pcbddc->local_primal_size != old_size) {
3869     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3870     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3871     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3872     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3873   }
3874   /* local explicit constraints */
3875   old_size = -1;
3876   if (pcbddc->vec1_C) {
3877     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3878   }
3879   if (n_constraints && n_constraints != old_size) {
3880     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3881     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3882     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3883     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3884   }
3885   PetscFunctionReturn(0);
3886 }
3887 
3888 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3889 {
3890   PetscErrorCode  ierr;
3891   /* pointers to pcis and pcbddc */
3892   PC_IS*          pcis = (PC_IS*)pc->data;
3893   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3894   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3895   /* submatrices of local problem */
3896   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3897   /* submatrices of local coarse problem */
3898   Mat             S_VV,S_CV,S_VC,S_CC;
3899   /* working matrices */
3900   Mat             C_CR;
3901   /* additional working stuff */
3902   PC              pc_R;
3903   Mat             F,Brhs = NULL;
3904   Vec             dummy_vec;
3905   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3906   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3907   PetscScalar     *work;
3908   PetscInt        *idx_V_B;
3909   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3910   PetscInt        i,n_R,n_D,n_B;
3911 
3912   /* some shortcuts to scalars */
3913   PetscScalar     one=1.0,m_one=-1.0;
3914 
3915   PetscFunctionBegin;
3916   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");
3917   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3918 
3919   /* Set Non-overlapping dimensions */
3920   n_vertices = pcbddc->n_vertices;
3921   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3922   n_B = pcis->n_B;
3923   n_D = pcis->n - n_B;
3924   n_R = pcis->n - n_vertices;
3925 
3926   /* vertices in boundary numbering */
3927   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3928   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3929   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3930 
3931   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3932   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3933   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3934   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3935   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3936   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3937   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3938   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3939   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3940   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3941 
3942   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3943   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3944   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3945   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3946   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3947   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3948   lda_rhs = n_R;
3949   need_benign_correction = PETSC_FALSE;
3950   if (isLU || isILU || isCHOL) {
3951     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3952   } else if (sub_schurs && sub_schurs->reuse_solver) {
3953     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3954     MatFactorType      type;
3955 
3956     F = reuse_solver->F;
3957     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3958     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3959     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3960     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3961   } else {
3962     F = NULL;
3963   }
3964 
3965   /* determine if we can use a sparse right-hand side */
3966   sparserhs = PETSC_FALSE;
3967   if (F) {
3968     MatSolverType solver;
3969 
3970     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3971     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3972   }
3973 
3974   /* allocate workspace */
3975   n = 0;
3976   if (n_constraints) {
3977     n += lda_rhs*n_constraints;
3978   }
3979   if (n_vertices) {
3980     n = PetscMax(2*lda_rhs*n_vertices,n);
3981     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3982   }
3983   if (!pcbddc->symmetric_primal) {
3984     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3985   }
3986   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3987 
3988   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3989   dummy_vec = NULL;
3990   if (need_benign_correction && lda_rhs != n_R && F) {
3991     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3992     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3993     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3994   }
3995 
3996   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3997   if (n_constraints) {
3998     Mat         M3,C_B;
3999     IS          is_aux;
4000     PetscScalar *array,*array2;
4001 
4002     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4003     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4004 
4005     /* Extract constraints on R nodes: C_{CR}  */
4006     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4007     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4008     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4009 
4010     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4011     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4012     if (!sparserhs) {
4013       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
4014       for (i=0;i<n_constraints;i++) {
4015         const PetscScalar *row_cmat_values;
4016         const PetscInt    *row_cmat_indices;
4017         PetscInt          size_of_constraint,j;
4018 
4019         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4020         for (j=0;j<size_of_constraint;j++) {
4021           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4022         }
4023         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4024       }
4025       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4026     } else {
4027       Mat tC_CR;
4028 
4029       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4030       if (lda_rhs != n_R) {
4031         PetscScalar *aa;
4032         PetscInt    r,*ii,*jj;
4033         PetscBool   done;
4034 
4035         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4036         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4037         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4038         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4039         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4040         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4041       } else {
4042         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4043         tC_CR = C_CR;
4044       }
4045       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4046       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4047     }
4048     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4049     if (F) {
4050       if (need_benign_correction) {
4051         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4052 
4053         /* rhs is already zero on interior dofs, no need to change the rhs */
4054         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
4055       }
4056       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4057       if (need_benign_correction) {
4058         PetscScalar        *marr;
4059         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4060 
4061         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4062         if (lda_rhs != n_R) {
4063           for (i=0;i<n_constraints;i++) {
4064             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4065             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4066             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4067           }
4068         } else {
4069           for (i=0;i<n_constraints;i++) {
4070             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4071             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4072             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4073           }
4074         }
4075         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4076       }
4077     } else {
4078       PetscScalar *marr;
4079 
4080       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4081       for (i=0;i<n_constraints;i++) {
4082         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4083         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4084         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4085         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4086         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4087         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4088       }
4089       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4090     }
4091     if (sparserhs) {
4092       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4093     }
4094     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4095     if (!pcbddc->switch_static) {
4096       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4097       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4098       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4099       for (i=0;i<n_constraints;i++) {
4100         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4101         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4102         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4103         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4104         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4105         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4106       }
4107       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4108       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4109       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4110     } else {
4111       if (lda_rhs != n_R) {
4112         IS dummy;
4113 
4114         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4115         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4116         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4117       } else {
4118         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4119         pcbddc->local_auxmat2 = local_auxmat2_R;
4120       }
4121       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4122     }
4123     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4124     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4125     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4126     if (isCHOL) {
4127       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4128     } else {
4129       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4130     }
4131     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4132     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4133     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4134     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4135     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4136     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4137   }
4138 
4139   /* Get submatrices from subdomain matrix */
4140   if (n_vertices) {
4141     IS        is_aux;
4142     PetscBool isseqaij;
4143 
4144     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4145       IS tis;
4146 
4147       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4148       ierr = ISSort(tis);CHKERRQ(ierr);
4149       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4150       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4151     } else {
4152       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4153     }
4154     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4155     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4156     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4157     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4158       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4159     }
4160     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4161     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4162   }
4163 
4164   /* Matrix of coarse basis functions (local) */
4165   if (pcbddc->coarse_phi_B) {
4166     PetscInt on_B,on_primal,on_D=n_D;
4167     if (pcbddc->coarse_phi_D) {
4168       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4169     }
4170     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4171     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4172       PetscScalar *marray;
4173 
4174       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4175       ierr = PetscFree(marray);CHKERRQ(ierr);
4176       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4177       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4178       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4179       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4180     }
4181   }
4182 
4183   if (!pcbddc->coarse_phi_B) {
4184     PetscScalar *marr;
4185 
4186     /* memory size */
4187     n = n_B*pcbddc->local_primal_size;
4188     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4189     if (!pcbddc->symmetric_primal) n *= 2;
4190     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4191     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4192     marr += n_B*pcbddc->local_primal_size;
4193     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4194       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4195       marr += n_D*pcbddc->local_primal_size;
4196     }
4197     if (!pcbddc->symmetric_primal) {
4198       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4199       marr += n_B*pcbddc->local_primal_size;
4200       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4201         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4202       }
4203     } else {
4204       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4205       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4206       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4207         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4208         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4209       }
4210     }
4211   }
4212 
4213   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4214   p0_lidx_I = NULL;
4215   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4216     const PetscInt *idxs;
4217 
4218     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4219     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4220     for (i=0;i<pcbddc->benign_n;i++) {
4221       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4222     }
4223     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4224   }
4225 
4226   /* vertices */
4227   if (n_vertices) {
4228     PetscBool restoreavr = PETSC_FALSE;
4229 
4230     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4231 
4232     if (n_R) {
4233       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4234       PetscBLASInt B_N,B_one = 1;
4235       PetscScalar  *x,*y;
4236 
4237       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4238       if (need_benign_correction) {
4239         ISLocalToGlobalMapping RtoN;
4240         IS                     is_p0;
4241         PetscInt               *idxs_p0,n;
4242 
4243         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4244         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4245         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4246         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);
4247         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4248         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4249         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4250         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4251       }
4252 
4253       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4254       if (!sparserhs || need_benign_correction) {
4255         if (lda_rhs == n_R) {
4256           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4257         } else {
4258           PetscScalar    *av,*array;
4259           const PetscInt *xadj,*adjncy;
4260           PetscInt       n;
4261           PetscBool      flg_row;
4262 
4263           array = work+lda_rhs*n_vertices;
4264           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4265           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4266           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4267           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4268           for (i=0;i<n;i++) {
4269             PetscInt j;
4270             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4271           }
4272           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4273           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4274           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4275         }
4276         if (need_benign_correction) {
4277           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4278           PetscScalar        *marr;
4279 
4280           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4281           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4282 
4283                  | 0 0  0 | (V)
4284              L = | 0 0 -1 | (P-p0)
4285                  | 0 0 -1 | (p0)
4286 
4287           */
4288           for (i=0;i<reuse_solver->benign_n;i++) {
4289             const PetscScalar *vals;
4290             const PetscInt    *idxs,*idxs_zero;
4291             PetscInt          n,j,nz;
4292 
4293             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4294             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4295             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4296             for (j=0;j<n;j++) {
4297               PetscScalar val = vals[j];
4298               PetscInt    k,col = idxs[j];
4299               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4300             }
4301             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4302             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4303           }
4304           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4305         }
4306         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4307         Brhs = A_RV;
4308       } else {
4309         Mat tA_RVT,A_RVT;
4310 
4311         if (!pcbddc->symmetric_primal) {
4312           /* A_RV already scaled by -1 */
4313           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4314         } else {
4315           restoreavr = PETSC_TRUE;
4316           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4317           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4318           A_RVT = A_VR;
4319         }
4320         if (lda_rhs != n_R) {
4321           PetscScalar *aa;
4322           PetscInt    r,*ii,*jj;
4323           PetscBool   done;
4324 
4325           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4326           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4327           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4328           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4329           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4330           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4331         } else {
4332           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4333           tA_RVT = A_RVT;
4334         }
4335         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4336         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4337         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4338       }
4339       if (F) {
4340         /* need to correct the rhs */
4341         if (need_benign_correction) {
4342           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4343           PetscScalar        *marr;
4344 
4345           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4346           if (lda_rhs != n_R) {
4347             for (i=0;i<n_vertices;i++) {
4348               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4349               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4350               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4351             }
4352           } else {
4353             for (i=0;i<n_vertices;i++) {
4354               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4355               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4356               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4357             }
4358           }
4359           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4360         }
4361         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4362         if (restoreavr) {
4363           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4364         }
4365         /* need to correct the solution */
4366         if (need_benign_correction) {
4367           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4368           PetscScalar        *marr;
4369 
4370           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4371           if (lda_rhs != n_R) {
4372             for (i=0;i<n_vertices;i++) {
4373               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4374               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4375               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4376             }
4377           } else {
4378             for (i=0;i<n_vertices;i++) {
4379               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4380               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4381               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4382             }
4383           }
4384           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4385         }
4386       } else {
4387         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4388         for (i=0;i<n_vertices;i++) {
4389           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4390           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4391           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4392           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4393           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4394           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4395         }
4396         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4397       }
4398       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4399       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4400       /* S_VV and S_CV */
4401       if (n_constraints) {
4402         Mat B;
4403 
4404         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4405         for (i=0;i<n_vertices;i++) {
4406           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4407           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4408           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4409           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4410           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4411           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4412         }
4413         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4414         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4415         ierr = MatDestroy(&B);CHKERRQ(ierr);
4416         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4417         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4418         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4419         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4420         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4421         ierr = MatDestroy(&B);CHKERRQ(ierr);
4422       }
4423       if (lda_rhs != n_R) {
4424         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4425         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4426         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4427       }
4428       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4429       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4430       if (need_benign_correction) {
4431         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4432         PetscScalar      *marr,*sums;
4433 
4434         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4435         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4436         for (i=0;i<reuse_solver->benign_n;i++) {
4437           const PetscScalar *vals;
4438           const PetscInt    *idxs,*idxs_zero;
4439           PetscInt          n,j,nz;
4440 
4441           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4442           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4443           for (j=0;j<n_vertices;j++) {
4444             PetscInt k;
4445             sums[j] = 0.;
4446             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4447           }
4448           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4449           for (j=0;j<n;j++) {
4450             PetscScalar val = vals[j];
4451             PetscInt k;
4452             for (k=0;k<n_vertices;k++) {
4453               marr[idxs[j]+k*n_vertices] += val*sums[k];
4454             }
4455           }
4456           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4457           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4458         }
4459         ierr = PetscFree(sums);CHKERRQ(ierr);
4460         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4461         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4462       }
4463       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4464       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4465       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4466       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4467       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4468       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4469       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4470       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4471       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4472     } else {
4473       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4474     }
4475     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4476 
4477     /* coarse basis functions */
4478     for (i=0;i<n_vertices;i++) {
4479       PetscScalar *y;
4480 
4481       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4482       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4483       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4484       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4485       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4486       y[n_B*i+idx_V_B[i]] = 1.0;
4487       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4488       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4489 
4490       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4491         PetscInt j;
4492 
4493         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4494         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4495         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4496         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4497         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4498         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4499         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4500       }
4501       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4502     }
4503     /* if n_R == 0 the object is not destroyed */
4504     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4505   }
4506   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4507 
4508   if (n_constraints) {
4509     Mat B;
4510 
4511     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4512     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4513     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4514     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4515     if (n_vertices) {
4516       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4517         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4518       } else {
4519         Mat S_VCt;
4520 
4521         if (lda_rhs != n_R) {
4522           ierr = MatDestroy(&B);CHKERRQ(ierr);
4523           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4524           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4525         }
4526         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4527         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4528         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4529       }
4530     }
4531     ierr = MatDestroy(&B);CHKERRQ(ierr);
4532     /* coarse basis functions */
4533     for (i=0;i<n_constraints;i++) {
4534       PetscScalar *y;
4535 
4536       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4537       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4538       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4539       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4540       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4541       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4542       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4543       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4544         PetscInt j;
4545 
4546         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4547         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4548         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4549         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4550         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4551         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4552         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4553       }
4554       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4555     }
4556   }
4557   if (n_constraints) {
4558     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4559   }
4560   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4561 
4562   /* coarse matrix entries relative to B_0 */
4563   if (pcbddc->benign_n) {
4564     Mat         B0_B,B0_BPHI;
4565     IS          is_dummy;
4566     PetscScalar *data;
4567     PetscInt    j;
4568 
4569     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4570     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4571     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4572     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4573     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4574     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4575     for (j=0;j<pcbddc->benign_n;j++) {
4576       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4577       for (i=0;i<pcbddc->local_primal_size;i++) {
4578         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4579         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4580       }
4581     }
4582     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4583     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4584     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4585   }
4586 
4587   /* compute other basis functions for non-symmetric problems */
4588   if (!pcbddc->symmetric_primal) {
4589     Mat         B_V=NULL,B_C=NULL;
4590     PetscScalar *marray;
4591 
4592     if (n_constraints) {
4593       Mat S_CCT,C_CRT;
4594 
4595       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4596       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4597       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4598       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4599       if (n_vertices) {
4600         Mat S_VCT;
4601 
4602         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4603         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4604         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4605       }
4606       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4607     } else {
4608       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4609     }
4610     if (n_vertices && n_R) {
4611       PetscScalar    *av,*marray;
4612       const PetscInt *xadj,*adjncy;
4613       PetscInt       n;
4614       PetscBool      flg_row;
4615 
4616       /* B_V = B_V - A_VR^T */
4617       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4618       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4619       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4620       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4621       for (i=0;i<n;i++) {
4622         PetscInt j;
4623         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4624       }
4625       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4626       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4627       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4628     }
4629 
4630     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4631     if (n_vertices) {
4632       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4633       for (i=0;i<n_vertices;i++) {
4634         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*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_V,&marray);CHKERRQ(ierr);
4642     }
4643     if (B_C) {
4644       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4645       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4646         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4647         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4648         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4649         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4650         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4651         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4652       }
4653       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4654     }
4655     /* coarse basis functions */
4656     for (i=0;i<pcbddc->local_primal_size;i++) {
4657       PetscScalar *y;
4658 
4659       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4660       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4661       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4662       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4663       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4664       if (i<n_vertices) {
4665         y[n_B*i+idx_V_B[i]] = 1.0;
4666       }
4667       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4668       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4669 
4670       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4671         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4672         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4673         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4674         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4675         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4676         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4677       }
4678       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4679     }
4680     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4681     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4682   }
4683 
4684   /* free memory */
4685   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4686   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4687   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4688   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4689   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4690   ierr = PetscFree(work);CHKERRQ(ierr);
4691   if (n_vertices) {
4692     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4693   }
4694   if (n_constraints) {
4695     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4696   }
4697   /* Checking coarse_sub_mat and coarse basis functios */
4698   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4699   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4700   if (pcbddc->dbg_flag) {
4701     Mat         coarse_sub_mat;
4702     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4703     Mat         coarse_phi_D,coarse_phi_B;
4704     Mat         coarse_psi_D,coarse_psi_B;
4705     Mat         A_II,A_BB,A_IB,A_BI;
4706     Mat         C_B,CPHI;
4707     IS          is_dummy;
4708     Vec         mones;
4709     MatType     checkmattype=MATSEQAIJ;
4710     PetscReal   real_value;
4711 
4712     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4713       Mat A;
4714       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4715       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4716       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4717       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4718       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4719       ierr = MatDestroy(&A);CHKERRQ(ierr);
4720     } else {
4721       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4722       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4723       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4724       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4725     }
4726     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4727     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4728     if (!pcbddc->symmetric_primal) {
4729       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4730       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4731     }
4732     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4733 
4734     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4735     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4736     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4737     if (!pcbddc->symmetric_primal) {
4738       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4739       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4740       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4741       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4742       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4743       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4744       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4745       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4746       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4747       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4748       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4749       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4750     } else {
4751       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4752       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4753       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4754       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4755       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4756       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4757       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4758       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4759     }
4760     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4761     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4762     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4763     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4764     if (pcbddc->benign_n) {
4765       Mat         B0_B,B0_BPHI;
4766       PetscScalar *data,*data2;
4767       PetscInt    j;
4768 
4769       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4770       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4771       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4772       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4773       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4774       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4775       for (j=0;j<pcbddc->benign_n;j++) {
4776         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4777         for (i=0;i<pcbddc->local_primal_size;i++) {
4778           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4779           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4780         }
4781       }
4782       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4783       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4784       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4785       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4786       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4787     }
4788 #if 0
4789   {
4790     PetscViewer viewer;
4791     char filename[256];
4792     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4793     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4794     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4795     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4796     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4797     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4798     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4799     if (pcbddc->coarse_phi_B) {
4800       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4801       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4802     }
4803     if (pcbddc->coarse_phi_D) {
4804       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4805       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4806     }
4807     if (pcbddc->coarse_psi_B) {
4808       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4809       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4810     }
4811     if (pcbddc->coarse_psi_D) {
4812       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4813       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4814     }
4815     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4816     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4817     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4818     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4819     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4820     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4821     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4822     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4823     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4824     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4825     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4826   }
4827 #endif
4828     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4829     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4830     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4831     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4832 
4833     /* check constraints */
4834     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4835     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4836     if (!pcbddc->benign_n) { /* TODO: add benign case */
4837       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4838     } else {
4839       PetscScalar *data;
4840       Mat         tmat;
4841       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4842       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4843       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4844       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4845       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4846     }
4847     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4848     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4849     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4850     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4851     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4852     if (!pcbddc->symmetric_primal) {
4853       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4854       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4855       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4856       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4857       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4858     }
4859     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4860     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4861     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4862     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4863     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4864     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4865     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4866     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4867     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4868     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4869     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4870     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4871     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4872     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4873     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4874     if (!pcbddc->symmetric_primal) {
4875       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4876       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4877     }
4878     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4879   }
4880   /* get back data */
4881   *coarse_submat_vals_n = coarse_submat_vals;
4882   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4883   PetscFunctionReturn(0);
4884 }
4885 
4886 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4887 {
4888   Mat            *work_mat;
4889   IS             isrow_s,iscol_s;
4890   PetscBool      rsorted,csorted;
4891   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4892   PetscErrorCode ierr;
4893 
4894   PetscFunctionBegin;
4895   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4896   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4897   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4898   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4899 
4900   if (!rsorted) {
4901     const PetscInt *idxs;
4902     PetscInt *idxs_sorted,i;
4903 
4904     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4905     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4906     for (i=0;i<rsize;i++) {
4907       idxs_perm_r[i] = i;
4908     }
4909     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4910     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4911     for (i=0;i<rsize;i++) {
4912       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4913     }
4914     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4915     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4916   } else {
4917     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4918     isrow_s = isrow;
4919   }
4920 
4921   if (!csorted) {
4922     if (isrow == iscol) {
4923       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4924       iscol_s = isrow_s;
4925     } else {
4926       const PetscInt *idxs;
4927       PetscInt       *idxs_sorted,i;
4928 
4929       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4930       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4931       for (i=0;i<csize;i++) {
4932         idxs_perm_c[i] = i;
4933       }
4934       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4935       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4936       for (i=0;i<csize;i++) {
4937         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4938       }
4939       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4940       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4941     }
4942   } else {
4943     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4944     iscol_s = iscol;
4945   }
4946 
4947   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4948 
4949   if (!rsorted || !csorted) {
4950     Mat      new_mat;
4951     IS       is_perm_r,is_perm_c;
4952 
4953     if (!rsorted) {
4954       PetscInt *idxs_r,i;
4955       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4956       for (i=0;i<rsize;i++) {
4957         idxs_r[idxs_perm_r[i]] = i;
4958       }
4959       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4960       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4961     } else {
4962       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4963     }
4964     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4965 
4966     if (!csorted) {
4967       if (isrow_s == iscol_s) {
4968         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4969         is_perm_c = is_perm_r;
4970       } else {
4971         PetscInt *idxs_c,i;
4972         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4973         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4974         for (i=0;i<csize;i++) {
4975           idxs_c[idxs_perm_c[i]] = i;
4976         }
4977         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4978         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4979       }
4980     } else {
4981       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4982     }
4983     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4984 
4985     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4986     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4987     work_mat[0] = new_mat;
4988     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4989     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4990   }
4991 
4992   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4993   *B = work_mat[0];
4994   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4995   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4996   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4997   PetscFunctionReturn(0);
4998 }
4999 
5000 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5001 {
5002   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5003   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5004   Mat            new_mat,lA;
5005   IS             is_local,is_global;
5006   PetscInt       local_size;
5007   PetscBool      isseqaij;
5008   PetscErrorCode ierr;
5009 
5010   PetscFunctionBegin;
5011   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5012   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5013   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5014   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5015   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5016   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5017   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5018 
5019   /* check */
5020   if (pcbddc->dbg_flag) {
5021     Vec       x,x_change;
5022     PetscReal error;
5023 
5024     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5025     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5026     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5027     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5028     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5029     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5030     if (!pcbddc->change_interior) {
5031       const PetscScalar *x,*y,*v;
5032       PetscReal         lerror = 0.;
5033       PetscInt          i;
5034 
5035       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5036       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5037       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5038       for (i=0;i<local_size;i++)
5039         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5040           lerror = PetscAbsScalar(x[i]-y[i]);
5041       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5042       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5043       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5044       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5045       if (error > PETSC_SMALL) {
5046         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5047           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5048         } else {
5049           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5050         }
5051       }
5052     }
5053     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5054     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5055     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5056     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5057     if (error > PETSC_SMALL) {
5058       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5059         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5060       } else {
5061         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5062       }
5063     }
5064     ierr = VecDestroy(&x);CHKERRQ(ierr);
5065     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5066   }
5067 
5068   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5069   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5070 
5071   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5072   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5073   if (isseqaij) {
5074     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5075     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5076     if (lA) {
5077       Mat work;
5078       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5079       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5080       ierr = MatDestroy(&work);CHKERRQ(ierr);
5081     }
5082   } else {
5083     Mat work_mat;
5084 
5085     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5086     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5087     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5088     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5089     if (lA) {
5090       Mat work;
5091       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5092       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5093       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5094       ierr = MatDestroy(&work);CHKERRQ(ierr);
5095     }
5096   }
5097   if (matis->A->symmetric_set) {
5098     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5099 #if !defined(PETSC_USE_COMPLEX)
5100     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5101 #endif
5102   }
5103   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5104   PetscFunctionReturn(0);
5105 }
5106 
5107 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5108 {
5109   PC_IS*          pcis = (PC_IS*)(pc->data);
5110   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5111   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5112   PetscInt        *idx_R_local=NULL;
5113   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5114   PetscInt        vbs,bs;
5115   PetscBT         bitmask=NULL;
5116   PetscErrorCode  ierr;
5117 
5118   PetscFunctionBegin;
5119   /*
5120     No need to setup local scatters if
5121       - primal space is unchanged
5122         AND
5123       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5124         AND
5125       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5126   */
5127   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5128     PetscFunctionReturn(0);
5129   }
5130   /* destroy old objects */
5131   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5132   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5133   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5134   /* Set Non-overlapping dimensions */
5135   n_B = pcis->n_B;
5136   n_D = pcis->n - n_B;
5137   n_vertices = pcbddc->n_vertices;
5138 
5139   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5140 
5141   /* create auxiliary bitmask and allocate workspace */
5142   if (!sub_schurs || !sub_schurs->reuse_solver) {
5143     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5144     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5145     for (i=0;i<n_vertices;i++) {
5146       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5147     }
5148 
5149     for (i=0, n_R=0; i<pcis->n; i++) {
5150       if (!PetscBTLookup(bitmask,i)) {
5151         idx_R_local[n_R++] = i;
5152       }
5153     }
5154   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5155     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5156 
5157     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5158     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5159   }
5160 
5161   /* Block code */
5162   vbs = 1;
5163   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5164   if (bs>1 && !(n_vertices%bs)) {
5165     PetscBool is_blocked = PETSC_TRUE;
5166     PetscInt  *vary;
5167     if (!sub_schurs || !sub_schurs->reuse_solver) {
5168       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5169       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5170       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5171       /* 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 */
5172       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5173       for (i=0; i<pcis->n/bs; i++) {
5174         if (vary[i]!=0 && vary[i]!=bs) {
5175           is_blocked = PETSC_FALSE;
5176           break;
5177         }
5178       }
5179       ierr = PetscFree(vary);CHKERRQ(ierr);
5180     } else {
5181       /* Verify directly the R set */
5182       for (i=0; i<n_R/bs; i++) {
5183         PetscInt j,node=idx_R_local[bs*i];
5184         for (j=1; j<bs; j++) {
5185           if (node != idx_R_local[bs*i+j]-j) {
5186             is_blocked = PETSC_FALSE;
5187             break;
5188           }
5189         }
5190       }
5191     }
5192     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5193       vbs = bs;
5194       for (i=0;i<n_R/vbs;i++) {
5195         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5196       }
5197     }
5198   }
5199   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5200   if (sub_schurs && sub_schurs->reuse_solver) {
5201     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5202 
5203     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5204     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5205     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5206     reuse_solver->is_R = pcbddc->is_R_local;
5207   } else {
5208     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5209   }
5210 
5211   /* print some info if requested */
5212   if (pcbddc->dbg_flag) {
5213     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5214     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5215     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5216     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5217     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5218     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);
5219     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5220   }
5221 
5222   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5223   if (!sub_schurs || !sub_schurs->reuse_solver) {
5224     IS       is_aux1,is_aux2;
5225     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5226 
5227     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5228     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5229     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5230     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5231     for (i=0; i<n_D; i++) {
5232       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5233     }
5234     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5235     for (i=0, j=0; i<n_R; i++) {
5236       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5237         aux_array1[j++] = i;
5238       }
5239     }
5240     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5241     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5242     for (i=0, j=0; i<n_B; i++) {
5243       if (!PetscBTLookup(bitmask,is_indices[i])) {
5244         aux_array2[j++] = i;
5245       }
5246     }
5247     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5248     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5249     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5250     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5251     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5252 
5253     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5254       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5255       for (i=0, j=0; i<n_R; i++) {
5256         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5257           aux_array1[j++] = i;
5258         }
5259       }
5260       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5261       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5262       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5263     }
5264     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5265     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5266   } else {
5267     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5268     IS                 tis;
5269     PetscInt           schur_size;
5270 
5271     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5272     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5273     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5274     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5275     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5276       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5277       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5278       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5279     }
5280   }
5281   PetscFunctionReturn(0);
5282 }
5283 
5284 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B)
5285 {
5286   MatNullSpace   NullSpace;
5287   Mat            dmat;
5288   const Vec      *nullvecs;
5289   Vec            v,v2,*nullvecs2;
5290   VecScatter     sct;
5291   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5292   PetscBool      nnsp_has_cnst;
5293   PetscErrorCode ierr;
5294 
5295   PetscFunctionBegin;
5296   ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5297   if (!NullSpace) {
5298     ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5299   }
5300   if (NullSpace) PetscFunctionReturn(0);
5301   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5302   if (!NullSpace) {
5303     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5304   }
5305   if (!NullSpace) PetscFunctionReturn(0);
5306   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5307   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5308   ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5309   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5310   bsiz = nnsp_size+!!nnsp_has_cnst;
5311   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5312   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5313   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5314   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5315   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5316   for (k=0;k<nnsp_size;k++) {
5317     PetscScalar *arr;
5318 
5319     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5320     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5321     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5322     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5323     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5324   }
5325   if (nnsp_has_cnst) {
5326     PetscScalar *arr;
5327 
5328     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5329     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5330     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5331     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5332   }
5333   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5334   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5335   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5336   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5337   for (k=0;k<bsiz;k++) {
5338     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5339   }
5340   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5341   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5342   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5343   ierr = VecDestroy(&v);CHKERRQ(ierr);
5344   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5345   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5346   PetscFunctionReturn(0);
5347 }
5348 
5349 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5350 {
5351   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5352   PC_IS          *pcis = (PC_IS*)pc->data;
5353   PC             pc_temp;
5354   Mat            A_RR;
5355   MatNullSpace   nnsp;
5356   MatReuse       reuse;
5357   PetscScalar    m_one = -1.0;
5358   PetscReal      value;
5359   PetscInt       n_D,n_R;
5360   PetscBool      issbaij,opts;
5361   PetscErrorCode ierr;
5362   void           (*f)(void) = 0;
5363   char           dir_prefix[256],neu_prefix[256],str_level[16];
5364   size_t         len;
5365 
5366   PetscFunctionBegin;
5367   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5368   /* compute prefixes */
5369   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5370   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5371   if (!pcbddc->current_level) {
5372     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5373     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));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   } else {
5377     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5378     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5379     len -= 15; /* remove "pc_bddc_coarse_" */
5380     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5381     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5382     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5383     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5384     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5385     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5386     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5387     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5388     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5389   }
5390 
5391   /* DIRICHLET PROBLEM */
5392   if (dirichlet) {
5393     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5394     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5395       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5396       if (pcbddc->dbg_flag) {
5397         Mat    A_IIn;
5398 
5399         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5400         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5401         pcis->A_II = A_IIn;
5402       }
5403     }
5404     if (pcbddc->local_mat->symmetric_set) {
5405       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5406     }
5407     /* Matrix for Dirichlet problem is pcis->A_II */
5408     n_D  = pcis->n - pcis->n_B;
5409     opts = PETSC_FALSE;
5410     if (!pcbddc->ksp_D) { /* create object if not yet build */
5411       opts = PETSC_TRUE;
5412       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5413       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5414       /* default */
5415       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5416       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5417       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5418       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5419       if (issbaij) {
5420         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5421       } else {
5422         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5423       }
5424       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5425     }
5426     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5427     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5428     /* Allow user's customization */
5429     if (opts) {
5430       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5431     }
5432     if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */
5433       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5434     }
5435     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5436     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5437     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5438     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5439       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5440       const PetscInt *idxs;
5441       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5442 
5443       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5444       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5445       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5446       for (i=0;i<nl;i++) {
5447         for (d=0;d<cdim;d++) {
5448           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5449         }
5450       }
5451       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5452       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5453       ierr = PetscFree(scoords);CHKERRQ(ierr);
5454     }
5455     if (sub_schurs && sub_schurs->reuse_solver) {
5456       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5457 
5458       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5459     }
5460 
5461     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5462     if (!n_D) {
5463       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5464       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5465     }
5466     /* set ksp_D into pcis data */
5467     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5468     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5469     pcis->ksp_D = pcbddc->ksp_D;
5470   }
5471 
5472   /* NEUMANN PROBLEM */
5473   A_RR = 0;
5474   if (neumann) {
5475     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5476     PetscInt        ibs,mbs;
5477     PetscBool       issbaij, reuse_neumann_solver;
5478     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5479 
5480     reuse_neumann_solver = PETSC_FALSE;
5481     if (sub_schurs && sub_schurs->reuse_solver) {
5482       IS iP;
5483 
5484       reuse_neumann_solver = PETSC_TRUE;
5485       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5486       if (iP) reuse_neumann_solver = PETSC_FALSE;
5487     }
5488     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5489     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5490     if (pcbddc->ksp_R) { /* already created ksp */
5491       PetscInt nn_R;
5492       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5493       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5494       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5495       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5496         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5497         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5498         reuse = MAT_INITIAL_MATRIX;
5499       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5500         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5501           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5502           reuse = MAT_INITIAL_MATRIX;
5503         } else { /* safe to reuse the matrix */
5504           reuse = MAT_REUSE_MATRIX;
5505         }
5506       }
5507       /* last check */
5508       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5509         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5510         reuse = MAT_INITIAL_MATRIX;
5511       }
5512     } else { /* first time, so we need to create the matrix */
5513       reuse = MAT_INITIAL_MATRIX;
5514     }
5515     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5516     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5517     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5518     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5519     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5520       if (matis->A == pcbddc->local_mat) {
5521         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5522         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5523       } else {
5524         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5525       }
5526     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5527       if (matis->A == pcbddc->local_mat) {
5528         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5529         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5530       } else {
5531         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5532       }
5533     }
5534     /* extract A_RR */
5535     if (reuse_neumann_solver) {
5536       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5537 
5538       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5539         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5540         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5541           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5542         } else {
5543           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5544         }
5545       } else {
5546         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5547         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5548         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5549       }
5550     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5551       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5552     }
5553     if (pcbddc->local_mat->symmetric_set) {
5554       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5555     }
5556     opts = PETSC_FALSE;
5557     if (!pcbddc->ksp_R) { /* create object if not present */
5558       opts = PETSC_TRUE;
5559       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5560       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5561       /* default */
5562       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5563       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5564       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5565       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5566       if (issbaij) {
5567         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5568       } else {
5569         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5570       }
5571       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5572     }
5573     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5574     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5575     if (opts) { /* Allow user's customization once */
5576       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5577     }
5578     if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */
5579       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5580     }
5581     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5582     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5583     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5584     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5585       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5586       const PetscInt *idxs;
5587       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5588 
5589       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5590       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5591       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5592       for (i=0;i<nl;i++) {
5593         for (d=0;d<cdim;d++) {
5594           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5595         }
5596       }
5597       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5598       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5599       ierr = PetscFree(scoords);CHKERRQ(ierr);
5600     }
5601 
5602     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5603     if (!n_R) {
5604       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5605       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5606     }
5607     /* Reuse solver if it is present */
5608     if (reuse_neumann_solver) {
5609       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5610 
5611       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5612     }
5613   }
5614 
5615   if (pcbddc->dbg_flag) {
5616     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5617     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5618     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5619   }
5620 
5621   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5622   if (pcbddc->NullSpace_corr[0]) {
5623     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5624   }
5625   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5626     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5627   }
5628   if (neumann && pcbddc->NullSpace_corr[2]) {
5629     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5630   }
5631   /* check Dirichlet and Neumann solvers */
5632   if (pcbddc->dbg_flag) {
5633     if (dirichlet) { /* Dirichlet */
5634       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5635       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5636       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5637       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5638       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5639       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5640       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);
5641       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5642     }
5643     if (neumann) { /* Neumann */
5644       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5645       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5646       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5647       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5648       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5649       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5650       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);
5651       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5652     }
5653   }
5654   /* free Neumann problem's matrix */
5655   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5656   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5657   PetscFunctionReturn(0);
5658 }
5659 
5660 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5661 {
5662   PetscErrorCode  ierr;
5663   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5664   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5665   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5666 
5667   PetscFunctionBegin;
5668   if (!reuse_solver) {
5669     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5670   }
5671   if (!pcbddc->switch_static) {
5672     if (applytranspose && pcbddc->local_auxmat1) {
5673       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5674       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5675     }
5676     if (!reuse_solver) {
5677       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5678       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5679     } else {
5680       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5681 
5682       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5683       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5684     }
5685   } else {
5686     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5687     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5688     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5689     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5690     if (applytranspose && pcbddc->local_auxmat1) {
5691       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5692       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5693       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5694       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5695     }
5696   }
5697   if (!reuse_solver || pcbddc->switch_static) {
5698     if (applytranspose) {
5699       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5700     } else {
5701       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5702     }
5703     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5704   } else {
5705     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5706 
5707     if (applytranspose) {
5708       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5709     } else {
5710       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5711     }
5712   }
5713   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5714   if (!pcbddc->switch_static) {
5715     if (!reuse_solver) {
5716       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5717       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5718     } else {
5719       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5720 
5721       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5722       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5723     }
5724     if (!applytranspose && pcbddc->local_auxmat1) {
5725       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5726       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5727     }
5728   } else {
5729     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5730     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5731     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5732     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5733     if (!applytranspose && pcbddc->local_auxmat1) {
5734       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5735       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5736     }
5737     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5738     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5739     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5740     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5741   }
5742   PetscFunctionReturn(0);
5743 }
5744 
5745 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5746 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5747 {
5748   PetscErrorCode ierr;
5749   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5750   PC_IS*            pcis = (PC_IS*)  (pc->data);
5751   const PetscScalar zero = 0.0;
5752 
5753   PetscFunctionBegin;
5754   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5755   if (!pcbddc->benign_apply_coarse_only) {
5756     if (applytranspose) {
5757       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5758       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5759     } else {
5760       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5761       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5762     }
5763   } else {
5764     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5765   }
5766 
5767   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5768   if (pcbddc->benign_n) {
5769     PetscScalar *array;
5770     PetscInt    j;
5771 
5772     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5773     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5774     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5775   }
5776 
5777   /* start communications from local primal nodes to rhs of coarse solver */
5778   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5779   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5780   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5781 
5782   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5783   if (pcbddc->coarse_ksp) {
5784     Mat          coarse_mat;
5785     Vec          rhs,sol;
5786     MatNullSpace nullsp;
5787     PetscBool    isbddc = PETSC_FALSE;
5788 
5789     if (pcbddc->benign_have_null) {
5790       PC        coarse_pc;
5791 
5792       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5793       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5794       /* we need to propagate to coarser levels the need for a possible benign correction */
5795       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5796         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5797         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5798         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5799       }
5800     }
5801     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5802     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5803     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5804     if (applytranspose) {
5805       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5806       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5807       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5808       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5809       if (nullsp) {
5810         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5811       }
5812     } else {
5813       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5814       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5815         PC        coarse_pc;
5816 
5817         if (nullsp) {
5818           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5819         }
5820         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5821         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5822         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5823         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5824       } else {
5825         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5826         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5827         if (nullsp) {
5828           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5829         }
5830       }
5831     }
5832     /* we don't need the benign correction at coarser levels anymore */
5833     if (pcbddc->benign_have_null && isbddc) {
5834       PC        coarse_pc;
5835       PC_BDDC*  coarsepcbddc;
5836 
5837       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5838       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5839       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5840       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5841     }
5842   }
5843 
5844   /* Local solution on R nodes */
5845   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5846     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5847   }
5848   /* communications from coarse sol to local primal nodes */
5849   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5850   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5851 
5852   /* Sum contributions from the two levels */
5853   if (!pcbddc->benign_apply_coarse_only) {
5854     if (applytranspose) {
5855       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5856       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5857     } else {
5858       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5859       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5860     }
5861     /* store p0 */
5862     if (pcbddc->benign_n) {
5863       PetscScalar *array;
5864       PetscInt    j;
5865 
5866       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5867       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5868       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5869     }
5870   } else { /* expand the coarse solution */
5871     if (applytranspose) {
5872       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5873     } else {
5874       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5875     }
5876   }
5877   PetscFunctionReturn(0);
5878 }
5879 
5880 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5881 {
5882   PetscErrorCode ierr;
5883   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5884   PetscScalar    *array;
5885   Vec            from,to;
5886 
5887   PetscFunctionBegin;
5888   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5889     from = pcbddc->coarse_vec;
5890     to = pcbddc->vec1_P;
5891     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5892       Vec tvec;
5893 
5894       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5895       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5896       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5897       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5898       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5899       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5900     }
5901   } else { /* from local to global -> put data in coarse right hand side */
5902     from = pcbddc->vec1_P;
5903     to = pcbddc->coarse_vec;
5904   }
5905   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5906   PetscFunctionReturn(0);
5907 }
5908 
5909 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5910 {
5911   PetscErrorCode ierr;
5912   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5913   PetscScalar    *array;
5914   Vec            from,to;
5915 
5916   PetscFunctionBegin;
5917   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5918     from = pcbddc->coarse_vec;
5919     to = pcbddc->vec1_P;
5920   } else { /* from local to global -> put data in coarse right hand side */
5921     from = pcbddc->vec1_P;
5922     to = pcbddc->coarse_vec;
5923   }
5924   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5925   if (smode == SCATTER_FORWARD) {
5926     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5927       Vec tvec;
5928 
5929       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5930       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5931       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5932       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5933     }
5934   } else {
5935     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5936      ierr = VecResetArray(from);CHKERRQ(ierr);
5937     }
5938   }
5939   PetscFunctionReturn(0);
5940 }
5941 
5942 /* uncomment for testing purposes */
5943 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5944 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5945 {
5946   PetscErrorCode    ierr;
5947   PC_IS*            pcis = (PC_IS*)(pc->data);
5948   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5949   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5950   /* one and zero */
5951   PetscScalar       one=1.0,zero=0.0;
5952   /* space to store constraints and their local indices */
5953   PetscScalar       *constraints_data;
5954   PetscInt          *constraints_idxs,*constraints_idxs_B;
5955   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5956   PetscInt          *constraints_n;
5957   /* iterators */
5958   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5959   /* BLAS integers */
5960   PetscBLASInt      lwork,lierr;
5961   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5962   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5963   /* reuse */
5964   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5965   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5966   /* change of basis */
5967   PetscBool         qr_needed;
5968   PetscBT           change_basis,qr_needed_idx;
5969   /* auxiliary stuff */
5970   PetscInt          *nnz,*is_indices;
5971   PetscInt          ncc;
5972   /* some quantities */
5973   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5974   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5975   PetscReal         tol; /* tolerance for retaining eigenmodes */
5976 
5977   PetscFunctionBegin;
5978   tol  = PetscSqrtReal(PETSC_SMALL);
5979   /* Destroy Mat objects computed previously */
5980   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5981   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5982   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5983   /* save info on constraints from previous setup (if any) */
5984   olocal_primal_size = pcbddc->local_primal_size;
5985   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5986   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5987   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5988   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5989   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5990   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5991 
5992   if (!pcbddc->adaptive_selection) {
5993     IS           ISForVertices,*ISForFaces,*ISForEdges;
5994     MatNullSpace nearnullsp;
5995     const Vec    *nearnullvecs;
5996     Vec          *localnearnullsp;
5997     PetscScalar  *array;
5998     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5999     PetscBool    nnsp_has_cnst;
6000     /* LAPACK working arrays for SVD or POD */
6001     PetscBool    skip_lapack,boolforchange;
6002     PetscScalar  *work;
6003     PetscReal    *singular_vals;
6004 #if defined(PETSC_USE_COMPLEX)
6005     PetscReal    *rwork;
6006 #endif
6007 #if defined(PETSC_MISSING_LAPACK_GESVD)
6008     PetscScalar  *temp_basis,*correlation_mat;
6009 #else
6010     PetscBLASInt dummy_int=1;
6011     PetscScalar  dummy_scalar=1.;
6012 #endif
6013 
6014     /* Get index sets for faces, edges and vertices from graph */
6015     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6016     /* print some info */
6017     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6018       PetscInt nv;
6019 
6020       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6021       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6022       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6023       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6024       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6025       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6026       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6027       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6028       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6029     }
6030 
6031     /* free unneeded index sets */
6032     if (!pcbddc->use_vertices) {
6033       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6034     }
6035     if (!pcbddc->use_edges) {
6036       for (i=0;i<n_ISForEdges;i++) {
6037         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6038       }
6039       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6040       n_ISForEdges = 0;
6041     }
6042     if (!pcbddc->use_faces) {
6043       for (i=0;i<n_ISForFaces;i++) {
6044         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6045       }
6046       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6047       n_ISForFaces = 0;
6048     }
6049 
6050     /* check if near null space is attached to global mat */
6051     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6052     if (nearnullsp) {
6053       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6054       /* remove any stored info */
6055       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6056       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6057       /* store information for BDDC solver reuse */
6058       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6059       pcbddc->onearnullspace = nearnullsp;
6060       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6061       for (i=0;i<nnsp_size;i++) {
6062         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6063       }
6064     } else { /* if near null space is not provided BDDC uses constants by default */
6065       nnsp_size = 0;
6066       nnsp_has_cnst = PETSC_TRUE;
6067     }
6068     /* get max number of constraints on a single cc */
6069     max_constraints = nnsp_size;
6070     if (nnsp_has_cnst) max_constraints++;
6071 
6072     /*
6073          Evaluate maximum storage size needed by the procedure
6074          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6075          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6076          There can be multiple constraints per connected component
6077                                                                                                                                                            */
6078     n_vertices = 0;
6079     if (ISForVertices) {
6080       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6081     }
6082     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6083     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6084 
6085     total_counts = n_ISForFaces+n_ISForEdges;
6086     total_counts *= max_constraints;
6087     total_counts += n_vertices;
6088     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6089 
6090     total_counts = 0;
6091     max_size_of_constraint = 0;
6092     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6093       IS used_is;
6094       if (i<n_ISForEdges) {
6095         used_is = ISForEdges[i];
6096       } else {
6097         used_is = ISForFaces[i-n_ISForEdges];
6098       }
6099       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6100       total_counts += j;
6101       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6102     }
6103     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);
6104 
6105     /* get local part of global near null space vectors */
6106     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6107     for (k=0;k<nnsp_size;k++) {
6108       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6109       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6110       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6111     }
6112 
6113     /* whether or not to skip lapack calls */
6114     skip_lapack = PETSC_TRUE;
6115     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6116 
6117     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6118     if (!skip_lapack) {
6119       PetscScalar temp_work;
6120 
6121 #if defined(PETSC_MISSING_LAPACK_GESVD)
6122       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6123       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6124       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6125       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6126 #if defined(PETSC_USE_COMPLEX)
6127       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6128 #endif
6129       /* now we evaluate the optimal workspace using query with lwork=-1 */
6130       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6131       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6132       lwork = -1;
6133       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6134 #if !defined(PETSC_USE_COMPLEX)
6135       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6136 #else
6137       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6138 #endif
6139       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6140       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6141 #else /* on missing GESVD */
6142       /* SVD */
6143       PetscInt max_n,min_n;
6144       max_n = max_size_of_constraint;
6145       min_n = max_constraints;
6146       if (max_size_of_constraint < max_constraints) {
6147         min_n = max_size_of_constraint;
6148         max_n = max_constraints;
6149       }
6150       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6151 #if defined(PETSC_USE_COMPLEX)
6152       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6153 #endif
6154       /* now we evaluate the optimal workspace using query with lwork=-1 */
6155       lwork = -1;
6156       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6157       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6158       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6159       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6160 #if !defined(PETSC_USE_COMPLEX)
6161       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));
6162 #else
6163       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));
6164 #endif
6165       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6166       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6167 #endif /* on missing GESVD */
6168       /* Allocate optimal workspace */
6169       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6170       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6171     }
6172     /* Now we can loop on constraining sets */
6173     total_counts = 0;
6174     constraints_idxs_ptr[0] = 0;
6175     constraints_data_ptr[0] = 0;
6176     /* vertices */
6177     if (n_vertices) {
6178       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6179       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6180       for (i=0;i<n_vertices;i++) {
6181         constraints_n[total_counts] = 1;
6182         constraints_data[total_counts] = 1.0;
6183         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6184         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6185         total_counts++;
6186       }
6187       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6188       n_vertices = total_counts;
6189     }
6190 
6191     /* edges and faces */
6192     total_counts_cc = total_counts;
6193     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6194       IS        used_is;
6195       PetscBool idxs_copied = PETSC_FALSE;
6196 
6197       if (ncc<n_ISForEdges) {
6198         used_is = ISForEdges[ncc];
6199         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6200       } else {
6201         used_is = ISForFaces[ncc-n_ISForEdges];
6202         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6203       }
6204       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6205 
6206       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6207       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6208       /* change of basis should not be performed on local periodic nodes */
6209       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6210       if (nnsp_has_cnst) {
6211         PetscScalar quad_value;
6212 
6213         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6214         idxs_copied = PETSC_TRUE;
6215 
6216         if (!pcbddc->use_nnsp_true) {
6217           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6218         } else {
6219           quad_value = 1.0;
6220         }
6221         for (j=0;j<size_of_constraint;j++) {
6222           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6223         }
6224         temp_constraints++;
6225         total_counts++;
6226       }
6227       for (k=0;k<nnsp_size;k++) {
6228         PetscReal real_value;
6229         PetscScalar *ptr_to_data;
6230 
6231         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6232         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6233         for (j=0;j<size_of_constraint;j++) {
6234           ptr_to_data[j] = array[is_indices[j]];
6235         }
6236         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6237         /* check if array is null on the connected component */
6238         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6239         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6240         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6241           temp_constraints++;
6242           total_counts++;
6243           if (!idxs_copied) {
6244             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6245             idxs_copied = PETSC_TRUE;
6246           }
6247         }
6248       }
6249       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6250       valid_constraints = temp_constraints;
6251       if (!pcbddc->use_nnsp_true && temp_constraints) {
6252         if (temp_constraints == 1) { /* just normalize the constraint */
6253           PetscScalar norm,*ptr_to_data;
6254 
6255           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6256           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6257           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6258           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6259           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6260         } else { /* perform SVD */
6261           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6262 
6263 #if defined(PETSC_MISSING_LAPACK_GESVD)
6264           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6265              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6266              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6267                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6268                 from that computed using LAPACKgesvd
6269              -> This is due to a different computation of eigenvectors in LAPACKheev
6270              -> The quality of the POD-computed basis will be the same */
6271           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6272           /* Store upper triangular part of correlation matrix */
6273           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6274           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6275           for (j=0;j<temp_constraints;j++) {
6276             for (k=0;k<j+1;k++) {
6277               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));
6278             }
6279           }
6280           /* compute eigenvalues and eigenvectors of correlation matrix */
6281           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6282           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6283 #if !defined(PETSC_USE_COMPLEX)
6284           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6285 #else
6286           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6287 #endif
6288           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6289           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6290           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6291           j = 0;
6292           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6293           total_counts = total_counts-j;
6294           valid_constraints = temp_constraints-j;
6295           /* scale and copy POD basis into used quadrature memory */
6296           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6297           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6298           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6299           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6300           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6301           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6302           if (j<temp_constraints) {
6303             PetscInt ii;
6304             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6305             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6306             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));
6307             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6308             for (k=0;k<temp_constraints-j;k++) {
6309               for (ii=0;ii<size_of_constraint;ii++) {
6310                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6311               }
6312             }
6313           }
6314 #else  /* on missing GESVD */
6315           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6316           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6317           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6318           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6319 #if !defined(PETSC_USE_COMPLEX)
6320           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));
6321 #else
6322           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));
6323 #endif
6324           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6325           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6326           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6327           k = temp_constraints;
6328           if (k > size_of_constraint) k = size_of_constraint;
6329           j = 0;
6330           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6331           valid_constraints = k-j;
6332           total_counts = total_counts-temp_constraints+valid_constraints;
6333 #endif /* on missing GESVD */
6334         }
6335       }
6336       /* update pointers information */
6337       if (valid_constraints) {
6338         constraints_n[total_counts_cc] = valid_constraints;
6339         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6340         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6341         /* set change_of_basis flag */
6342         if (boolforchange) {
6343           PetscBTSet(change_basis,total_counts_cc);
6344         }
6345         total_counts_cc++;
6346       }
6347     }
6348     /* free workspace */
6349     if (!skip_lapack) {
6350       ierr = PetscFree(work);CHKERRQ(ierr);
6351 #if defined(PETSC_USE_COMPLEX)
6352       ierr = PetscFree(rwork);CHKERRQ(ierr);
6353 #endif
6354       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6355 #if defined(PETSC_MISSING_LAPACK_GESVD)
6356       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6357       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6358 #endif
6359     }
6360     for (k=0;k<nnsp_size;k++) {
6361       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6362     }
6363     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6364     /* free index sets of faces, edges and vertices */
6365     for (i=0;i<n_ISForFaces;i++) {
6366       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6367     }
6368     if (n_ISForFaces) {
6369       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6370     }
6371     for (i=0;i<n_ISForEdges;i++) {
6372       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6373     }
6374     if (n_ISForEdges) {
6375       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6376     }
6377     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6378   } else {
6379     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6380 
6381     total_counts = 0;
6382     n_vertices = 0;
6383     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6384       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6385     }
6386     max_constraints = 0;
6387     total_counts_cc = 0;
6388     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6389       total_counts += pcbddc->adaptive_constraints_n[i];
6390       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6391       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6392     }
6393     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6394     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6395     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6396     constraints_data = pcbddc->adaptive_constraints_data;
6397     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6398     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6399     total_counts_cc = 0;
6400     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6401       if (pcbddc->adaptive_constraints_n[i]) {
6402         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6403       }
6404     }
6405 
6406     max_size_of_constraint = 0;
6407     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]);
6408     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6409     /* Change of basis */
6410     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6411     if (pcbddc->use_change_of_basis) {
6412       for (i=0;i<sub_schurs->n_subs;i++) {
6413         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6414           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6415         }
6416       }
6417     }
6418   }
6419   pcbddc->local_primal_size = total_counts;
6420   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6421 
6422   /* map constraints_idxs in boundary numbering */
6423   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6424   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);
6425 
6426   /* Create constraint matrix */
6427   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6428   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6429   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6430 
6431   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6432   /* determine if a QR strategy is needed for change of basis */
6433   qr_needed = pcbddc->use_qr_single;
6434   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6435   total_primal_vertices=0;
6436   pcbddc->local_primal_size_cc = 0;
6437   for (i=0;i<total_counts_cc;i++) {
6438     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6439     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6440       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6441       pcbddc->local_primal_size_cc += 1;
6442     } else if (PetscBTLookup(change_basis,i)) {
6443       for (k=0;k<constraints_n[i];k++) {
6444         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6445       }
6446       pcbddc->local_primal_size_cc += constraints_n[i];
6447       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6448         PetscBTSet(qr_needed_idx,i);
6449         qr_needed = PETSC_TRUE;
6450       }
6451     } else {
6452       pcbddc->local_primal_size_cc += 1;
6453     }
6454   }
6455   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6456   pcbddc->n_vertices = total_primal_vertices;
6457   /* permute indices in order to have a sorted set of vertices */
6458   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6459   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);
6460   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6461   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6462 
6463   /* nonzero structure of constraint matrix */
6464   /* and get reference dof for local constraints */
6465   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6466   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6467 
6468   j = total_primal_vertices;
6469   total_counts = total_primal_vertices;
6470   cum = total_primal_vertices;
6471   for (i=n_vertices;i<total_counts_cc;i++) {
6472     if (!PetscBTLookup(change_basis,i)) {
6473       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6474       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6475       cum++;
6476       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6477       for (k=0;k<constraints_n[i];k++) {
6478         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6479         nnz[j+k] = size_of_constraint;
6480       }
6481       j += constraints_n[i];
6482     }
6483   }
6484   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6485   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6486   ierr = PetscFree(nnz);CHKERRQ(ierr);
6487 
6488   /* set values in constraint matrix */
6489   for (i=0;i<total_primal_vertices;i++) {
6490     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6491   }
6492   total_counts = total_primal_vertices;
6493   for (i=n_vertices;i<total_counts_cc;i++) {
6494     if (!PetscBTLookup(change_basis,i)) {
6495       PetscInt *cols;
6496 
6497       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6498       cols = constraints_idxs+constraints_idxs_ptr[i];
6499       for (k=0;k<constraints_n[i];k++) {
6500         PetscInt    row = total_counts+k;
6501         PetscScalar *vals;
6502 
6503         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6504         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6505       }
6506       total_counts += constraints_n[i];
6507     }
6508   }
6509   /* assembling */
6510   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6511   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6512   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6513 
6514   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6515   if (pcbddc->use_change_of_basis) {
6516     /* dual and primal dofs on a single cc */
6517     PetscInt     dual_dofs,primal_dofs;
6518     /* working stuff for GEQRF */
6519     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6520     PetscBLASInt lqr_work;
6521     /* working stuff for UNGQR */
6522     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6523     PetscBLASInt lgqr_work;
6524     /* working stuff for TRTRS */
6525     PetscScalar  *trs_rhs = NULL;
6526     PetscBLASInt Blas_NRHS;
6527     /* pointers for values insertion into change of basis matrix */
6528     PetscInt     *start_rows,*start_cols;
6529     PetscScalar  *start_vals;
6530     /* working stuff for values insertion */
6531     PetscBT      is_primal;
6532     PetscInt     *aux_primal_numbering_B;
6533     /* matrix sizes */
6534     PetscInt     global_size,local_size;
6535     /* temporary change of basis */
6536     Mat          localChangeOfBasisMatrix;
6537     /* extra space for debugging */
6538     PetscScalar  *dbg_work = NULL;
6539 
6540     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6541     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6542     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6543     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6544     /* nonzeros for local mat */
6545     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6546     if (!pcbddc->benign_change || pcbddc->fake_change) {
6547       for (i=0;i<pcis->n;i++) nnz[i]=1;
6548     } else {
6549       const PetscInt *ii;
6550       PetscInt       n;
6551       PetscBool      flg_row;
6552       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6553       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6554       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6555     }
6556     for (i=n_vertices;i<total_counts_cc;i++) {
6557       if (PetscBTLookup(change_basis,i)) {
6558         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6559         if (PetscBTLookup(qr_needed_idx,i)) {
6560           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6561         } else {
6562           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6563           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6564         }
6565       }
6566     }
6567     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6568     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6569     ierr = PetscFree(nnz);CHKERRQ(ierr);
6570     /* Set interior change in the matrix */
6571     if (!pcbddc->benign_change || pcbddc->fake_change) {
6572       for (i=0;i<pcis->n;i++) {
6573         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6574       }
6575     } else {
6576       const PetscInt *ii,*jj;
6577       PetscScalar    *aa;
6578       PetscInt       n;
6579       PetscBool      flg_row;
6580       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6581       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6582       for (i=0;i<n;i++) {
6583         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6584       }
6585       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6586       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6587     }
6588 
6589     if (pcbddc->dbg_flag) {
6590       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6591       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6592     }
6593 
6594 
6595     /* Now we loop on the constraints which need a change of basis */
6596     /*
6597        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6598        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6599 
6600        Basic blocks of change of basis matrix T computed by
6601 
6602           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6603 
6604             | 1        0   ...        0         s_1/S |
6605             | 0        1   ...        0         s_2/S |
6606             |              ...                        |
6607             | 0        ...            1     s_{n-1}/S |
6608             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6609 
6610             with S = \sum_{i=1}^n s_i^2
6611             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6612                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6613 
6614           - QR decomposition of constraints otherwise
6615     */
6616     if (qr_needed && max_size_of_constraint) {
6617       /* space to store Q */
6618       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6619       /* array to store scaling factors for reflectors */
6620       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6621       /* first we issue queries for optimal work */
6622       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6623       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6624       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6625       lqr_work = -1;
6626       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6627       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6628       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6629       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6630       lgqr_work = -1;
6631       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6632       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6633       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6634       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6635       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6636       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6637       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6638       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6639       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6640       /* array to store rhs and solution of triangular solver */
6641       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6642       /* allocating workspace for check */
6643       if (pcbddc->dbg_flag) {
6644         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6645       }
6646     }
6647     /* array to store whether a node is primal or not */
6648     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6649     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6650     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6651     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);
6652     for (i=0;i<total_primal_vertices;i++) {
6653       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6654     }
6655     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6656 
6657     /* loop on constraints and see whether or not they need a change of basis and compute it */
6658     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6659       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6660       if (PetscBTLookup(change_basis,total_counts)) {
6661         /* get constraint info */
6662         primal_dofs = constraints_n[total_counts];
6663         dual_dofs = size_of_constraint-primal_dofs;
6664 
6665         if (pcbddc->dbg_flag) {
6666           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);
6667         }
6668 
6669         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6670 
6671           /* copy quadrature constraints for change of basis check */
6672           if (pcbddc->dbg_flag) {
6673             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6674           }
6675           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6676           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6677 
6678           /* compute QR decomposition of constraints */
6679           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6680           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6681           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6682           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6683           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6684           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6685           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6686 
6687           /* explictly compute R^-T */
6688           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6689           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6690           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6691           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6692           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6693           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6694           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6695           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6696           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6697           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6698 
6699           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6700           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6701           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6702           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6703           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6704           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6705           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6706           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6707           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6708 
6709           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6710              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6711              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6712           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6713           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6714           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6715           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6716           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6717           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6718           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6719           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));
6720           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6721           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6722 
6723           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6724           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6725           /* insert cols for primal dofs */
6726           for (j=0;j<primal_dofs;j++) {
6727             start_vals = &qr_basis[j*size_of_constraint];
6728             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6729             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6730           }
6731           /* insert cols for dual dofs */
6732           for (j=0,k=0;j<dual_dofs;k++) {
6733             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6734               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6735               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6736               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6737               j++;
6738             }
6739           }
6740 
6741           /* check change of basis */
6742           if (pcbddc->dbg_flag) {
6743             PetscInt   ii,jj;
6744             PetscBool valid_qr=PETSC_TRUE;
6745             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6746             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6747             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6748             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6749             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6750             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6751             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6752             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));
6753             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6754             for (jj=0;jj<size_of_constraint;jj++) {
6755               for (ii=0;ii<primal_dofs;ii++) {
6756                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6757                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6758               }
6759             }
6760             if (!valid_qr) {
6761               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6762               for (jj=0;jj<size_of_constraint;jj++) {
6763                 for (ii=0;ii<primal_dofs;ii++) {
6764                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6765                     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);
6766                   }
6767                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6768                     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);
6769                   }
6770                 }
6771               }
6772             } else {
6773               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6774             }
6775           }
6776         } else { /* simple transformation block */
6777           PetscInt    row,col;
6778           PetscScalar val,norm;
6779 
6780           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6781           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6782           for (j=0;j<size_of_constraint;j++) {
6783             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6784             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6785             if (!PetscBTLookup(is_primal,row_B)) {
6786               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6787               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6788               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6789             } else {
6790               for (k=0;k<size_of_constraint;k++) {
6791                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6792                 if (row != col) {
6793                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6794                 } else {
6795                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6796                 }
6797                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6798               }
6799             }
6800           }
6801           if (pcbddc->dbg_flag) {
6802             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6803           }
6804         }
6805       } else {
6806         if (pcbddc->dbg_flag) {
6807           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6808         }
6809       }
6810     }
6811 
6812     /* free workspace */
6813     if (qr_needed) {
6814       if (pcbddc->dbg_flag) {
6815         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6816       }
6817       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6818       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6819       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6820       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6821       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6822     }
6823     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6824     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6825     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6826 
6827     /* assembling of global change of variable */
6828     if (!pcbddc->fake_change) {
6829       Mat      tmat;
6830       PetscInt bs;
6831 
6832       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6833       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6834       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6835       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6836       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6837       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6838       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6839       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6840       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6841       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6842       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6843       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6844       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6845       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6846       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6847       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6848       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6849       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6850       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6851       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6852 
6853       /* check */
6854       if (pcbddc->dbg_flag) {
6855         PetscReal error;
6856         Vec       x,x_change;
6857 
6858         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6859         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6860         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6861         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6862         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6863         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6864         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6865         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6866         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6867         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6868         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6869         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6870         if (error > PETSC_SMALL) {
6871           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6872         }
6873         ierr = VecDestroy(&x);CHKERRQ(ierr);
6874         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6875       }
6876       /* adapt sub_schurs computed (if any) */
6877       if (pcbddc->use_deluxe_scaling) {
6878         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6879 
6880         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");
6881         if (sub_schurs && sub_schurs->S_Ej_all) {
6882           Mat                    S_new,tmat;
6883           IS                     is_all_N,is_V_Sall = NULL;
6884 
6885           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6886           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6887           if (pcbddc->deluxe_zerorows) {
6888             ISLocalToGlobalMapping NtoSall;
6889             IS                     is_V;
6890             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6891             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6892             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6893             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6894             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6895           }
6896           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6897           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6898           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6899           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6900           if (pcbddc->deluxe_zerorows) {
6901             const PetscScalar *array;
6902             const PetscInt    *idxs_V,*idxs_all;
6903             PetscInt          i,n_V;
6904 
6905             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6906             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6907             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6908             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6909             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6910             for (i=0;i<n_V;i++) {
6911               PetscScalar val;
6912               PetscInt    idx;
6913 
6914               idx = idxs_V[i];
6915               val = array[idxs_all[idxs_V[i]]];
6916               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6917             }
6918             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6919             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6920             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6921             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6922             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6923           }
6924           sub_schurs->S_Ej_all = S_new;
6925           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6926           if (sub_schurs->sum_S_Ej_all) {
6927             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6928             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6929             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6930             if (pcbddc->deluxe_zerorows) {
6931               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6932             }
6933             sub_schurs->sum_S_Ej_all = S_new;
6934             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6935           }
6936           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6937           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6938         }
6939         /* destroy any change of basis context in sub_schurs */
6940         if (sub_schurs && sub_schurs->change) {
6941           PetscInt i;
6942 
6943           for (i=0;i<sub_schurs->n_subs;i++) {
6944             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6945           }
6946           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6947         }
6948       }
6949       if (pcbddc->switch_static) { /* need to save the local change */
6950         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6951       } else {
6952         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6953       }
6954       /* determine if any process has changed the pressures locally */
6955       pcbddc->change_interior = pcbddc->benign_have_null;
6956     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6957       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6958       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6959       pcbddc->use_qr_single = qr_needed;
6960     }
6961   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6962     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6963       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6964       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6965     } else {
6966       Mat benign_global = NULL;
6967       if (pcbddc->benign_have_null) {
6968         Mat M;
6969 
6970         pcbddc->change_interior = PETSC_TRUE;
6971         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6972         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6973         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6974         if (pcbddc->benign_change) {
6975           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6976           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6977         } else {
6978           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6979           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6980         }
6981         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6982         ierr = MatDestroy(&M);CHKERRQ(ierr);
6983         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6984         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6985       }
6986       if (pcbddc->user_ChangeOfBasisMatrix) {
6987         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6988         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6989       } else if (pcbddc->benign_have_null) {
6990         pcbddc->ChangeOfBasisMatrix = benign_global;
6991       }
6992     }
6993     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6994       IS             is_global;
6995       const PetscInt *gidxs;
6996 
6997       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6998       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6999       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7000       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7001       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7002     }
7003   }
7004   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7005     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7006   }
7007 
7008   if (!pcbddc->fake_change) {
7009     /* add pressure dofs to set of primal nodes for numbering purposes */
7010     for (i=0;i<pcbddc->benign_n;i++) {
7011       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7012       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7013       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7014       pcbddc->local_primal_size_cc++;
7015       pcbddc->local_primal_size++;
7016     }
7017 
7018     /* check if a new primal space has been introduced (also take into account benign trick) */
7019     pcbddc->new_primal_space_local = PETSC_TRUE;
7020     if (olocal_primal_size == pcbddc->local_primal_size) {
7021       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7022       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7023       if (!pcbddc->new_primal_space_local) {
7024         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7025         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7026       }
7027     }
7028     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7029     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7030   }
7031   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7032 
7033   /* flush dbg viewer */
7034   if (pcbddc->dbg_flag) {
7035     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7036   }
7037 
7038   /* free workspace */
7039   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7040   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7041   if (!pcbddc->adaptive_selection) {
7042     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7043     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7044   } else {
7045     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7046                       pcbddc->adaptive_constraints_idxs_ptr,
7047                       pcbddc->adaptive_constraints_data_ptr,
7048                       pcbddc->adaptive_constraints_idxs,
7049                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7050     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7051     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7052   }
7053   PetscFunctionReturn(0);
7054 }
7055 /* #undef PETSC_MISSING_LAPACK_GESVD */
7056 
7057 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7058 {
7059   ISLocalToGlobalMapping map;
7060   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7061   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7062   PetscInt               i,N;
7063   PetscBool              rcsr = PETSC_FALSE;
7064   PetscErrorCode         ierr;
7065 
7066   PetscFunctionBegin;
7067   if (pcbddc->recompute_topography) {
7068     pcbddc->graphanalyzed = PETSC_FALSE;
7069     /* Reset previously computed graph */
7070     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7071     /* Init local Graph struct */
7072     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7073     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7074     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7075 
7076     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7077       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7078     }
7079     /* Check validity of the csr graph passed in by the user */
7080     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);
7081 
7082     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7083     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7084       PetscInt  *xadj,*adjncy;
7085       PetscInt  nvtxs;
7086       PetscBool flg_row=PETSC_FALSE;
7087 
7088       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7089       if (flg_row) {
7090         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7091         pcbddc->computed_rowadj = PETSC_TRUE;
7092       }
7093       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7094       rcsr = PETSC_TRUE;
7095     }
7096     if (pcbddc->dbg_flag) {
7097       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7098     }
7099 
7100     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7101       PetscReal    *lcoords;
7102       PetscInt     n;
7103       MPI_Datatype dimrealtype;
7104 
7105       /* TODO: support for blocked */
7106       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);
7107       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7108       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7109       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7110       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7111       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7112       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7113       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7114       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7115 
7116       pcbddc->mat_graph->coords = lcoords;
7117       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7118       pcbddc->mat_graph->cnloc  = n;
7119     }
7120     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);
7121     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7122 
7123     /* Setup of Graph */
7124     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7125     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7126 
7127     /* attach info on disconnected subdomains if present */
7128     if (pcbddc->n_local_subs) {
7129       PetscInt *local_subs,n,totn;
7130 
7131       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7132       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7133       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7134       for (i=0;i<pcbddc->n_local_subs;i++) {
7135         const PetscInt *idxs;
7136         PetscInt       nl,j;
7137 
7138         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7139         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7140         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7141         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7142       }
7143       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7144       pcbddc->mat_graph->n_local_subs = totn + 1;
7145       pcbddc->mat_graph->local_subs = local_subs;
7146     }
7147   }
7148 
7149   if (!pcbddc->graphanalyzed) {
7150     /* Graph's connected components analysis */
7151     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7152     pcbddc->graphanalyzed = PETSC_TRUE;
7153     pcbddc->corner_selected = pcbddc->corner_selection;
7154   }
7155   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7156   PetscFunctionReturn(0);
7157 }
7158 
7159 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7160 {
7161   PetscInt       i,j;
7162   PetscScalar    *alphas;
7163   PetscReal      norm;
7164   PetscErrorCode ierr;
7165 
7166   PetscFunctionBegin;
7167   if (!n) PetscFunctionReturn(0);
7168   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7169   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7170   if (norm < PETSC_SMALL) {
7171     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7172   }
7173   for (i=1;i<n;i++) {
7174     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7175     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7176     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7177     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7178     if (norm < PETSC_SMALL) {
7179       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7180     }
7181   }
7182   ierr = PetscFree(alphas);CHKERRQ(ierr);
7183   PetscFunctionReturn(0);
7184 }
7185 
7186 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7187 {
7188   Mat            A;
7189   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7190   PetscMPIInt    size,rank,color;
7191   PetscInt       *xadj,*adjncy;
7192   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7193   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7194   PetscInt       void_procs,*procs_candidates = NULL;
7195   PetscInt       xadj_count,*count;
7196   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7197   PetscSubcomm   psubcomm;
7198   MPI_Comm       subcomm;
7199   PetscErrorCode ierr;
7200 
7201   PetscFunctionBegin;
7202   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7203   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7204   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);
7205   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7206   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7207   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7208 
7209   if (have_void) *have_void = PETSC_FALSE;
7210   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7211   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7212   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7213   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7214   im_active = !!n;
7215   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7216   void_procs = size - active_procs;
7217   /* get ranks of of non-active processes in mat communicator */
7218   if (void_procs) {
7219     PetscInt ncand;
7220 
7221     if (have_void) *have_void = PETSC_TRUE;
7222     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7223     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7224     for (i=0,ncand=0;i<size;i++) {
7225       if (!procs_candidates[i]) {
7226         procs_candidates[ncand++] = i;
7227       }
7228     }
7229     /* force n_subdomains to be not greater that the number of non-active processes */
7230     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7231   }
7232 
7233   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7234      number of subdomains requested 1 -> send to master or first candidate in voids  */
7235   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7236   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7237     PetscInt issize,isidx,dest;
7238     if (*n_subdomains == 1) dest = 0;
7239     else dest = rank;
7240     if (im_active) {
7241       issize = 1;
7242       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7243         isidx = procs_candidates[dest];
7244       } else {
7245         isidx = dest;
7246       }
7247     } else {
7248       issize = 0;
7249       isidx = -1;
7250     }
7251     if (*n_subdomains != 1) *n_subdomains = active_procs;
7252     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7253     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7254     PetscFunctionReturn(0);
7255   }
7256   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7257   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7258   threshold = PetscMax(threshold,2);
7259 
7260   /* Get info on mapping */
7261   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7262 
7263   /* build local CSR graph of subdomains' connectivity */
7264   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7265   xadj[0] = 0;
7266   xadj[1] = PetscMax(n_neighs-1,0);
7267   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7268   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7269   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7270   for (i=1;i<n_neighs;i++)
7271     for (j=0;j<n_shared[i];j++)
7272       count[shared[i][j]] += 1;
7273 
7274   xadj_count = 0;
7275   for (i=1;i<n_neighs;i++) {
7276     for (j=0;j<n_shared[i];j++) {
7277       if (count[shared[i][j]] < threshold) {
7278         adjncy[xadj_count] = neighs[i];
7279         adjncy_wgt[xadj_count] = n_shared[i];
7280         xadj_count++;
7281         break;
7282       }
7283     }
7284   }
7285   xadj[1] = xadj_count;
7286   ierr = PetscFree(count);CHKERRQ(ierr);
7287   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7288   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7289 
7290   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7291 
7292   /* Restrict work on active processes only */
7293   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7294   if (void_procs) {
7295     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7296     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7297     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7298     subcomm = PetscSubcommChild(psubcomm);
7299   } else {
7300     psubcomm = NULL;
7301     subcomm = PetscObjectComm((PetscObject)mat);
7302   }
7303 
7304   v_wgt = NULL;
7305   if (!color) {
7306     ierr = PetscFree(xadj);CHKERRQ(ierr);
7307     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7308     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7309   } else {
7310     Mat             subdomain_adj;
7311     IS              new_ranks,new_ranks_contig;
7312     MatPartitioning partitioner;
7313     PetscInt        rstart=0,rend=0;
7314     PetscInt        *is_indices,*oldranks;
7315     PetscMPIInt     size;
7316     PetscBool       aggregate;
7317 
7318     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7319     if (void_procs) {
7320       PetscInt prank = rank;
7321       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7322       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7323       for (i=0;i<xadj[1];i++) {
7324         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7325       }
7326       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7327     } else {
7328       oldranks = NULL;
7329     }
7330     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7331     if (aggregate) { /* TODO: all this part could be made more efficient */
7332       PetscInt    lrows,row,ncols,*cols;
7333       PetscMPIInt nrank;
7334       PetscScalar *vals;
7335 
7336       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7337       lrows = 0;
7338       if (nrank<redprocs) {
7339         lrows = size/redprocs;
7340         if (nrank<size%redprocs) lrows++;
7341       }
7342       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7343       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7344       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7345       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7346       row = nrank;
7347       ncols = xadj[1]-xadj[0];
7348       cols = adjncy;
7349       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7350       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7351       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7352       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7353       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7354       ierr = PetscFree(xadj);CHKERRQ(ierr);
7355       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7356       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7357       ierr = PetscFree(vals);CHKERRQ(ierr);
7358       if (use_vwgt) {
7359         Vec               v;
7360         const PetscScalar *array;
7361         PetscInt          nl;
7362 
7363         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7364         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7365         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7366         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7367         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7368         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7369         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7370         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7371         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7372         ierr = VecDestroy(&v);CHKERRQ(ierr);
7373       }
7374     } else {
7375       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7376       if (use_vwgt) {
7377         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7378         v_wgt[0] = n;
7379       }
7380     }
7381     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7382 
7383     /* Partition */
7384     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7385 #if defined(PETSC_HAVE_PTSCOTCH)
7386     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7387 #elif defined(PETSC_HAVE_PARMETIS)
7388     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7389 #else
7390     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7391 #endif
7392     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7393     if (v_wgt) {
7394       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7395     }
7396     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7397     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7398     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7399     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7400     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7401 
7402     /* renumber new_ranks to avoid "holes" in new set of processors */
7403     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7404     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7405     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7406     if (!aggregate) {
7407       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7408 #if defined(PETSC_USE_DEBUG)
7409         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7410 #endif
7411         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7412       } else if (oldranks) {
7413         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7414       } else {
7415         ranks_send_to_idx[0] = is_indices[0];
7416       }
7417     } else {
7418       PetscInt    idx = 0;
7419       PetscMPIInt tag;
7420       MPI_Request *reqs;
7421 
7422       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7423       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7424       for (i=rstart;i<rend;i++) {
7425         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7426       }
7427       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7428       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7429       ierr = PetscFree(reqs);CHKERRQ(ierr);
7430       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7431 #if defined(PETSC_USE_DEBUG)
7432         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7433 #endif
7434         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7435       } else if (oldranks) {
7436         ranks_send_to_idx[0] = oldranks[idx];
7437       } else {
7438         ranks_send_to_idx[0] = idx;
7439       }
7440     }
7441     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7442     /* clean up */
7443     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7444     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7445     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7446     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7447   }
7448   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7449   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7450 
7451   /* assemble parallel IS for sends */
7452   i = 1;
7453   if (!color) i=0;
7454   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7455   PetscFunctionReturn(0);
7456 }
7457 
7458 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7459 
7460 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[])
7461 {
7462   Mat                    local_mat;
7463   IS                     is_sends_internal;
7464   PetscInt               rows,cols,new_local_rows;
7465   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7466   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7467   ISLocalToGlobalMapping l2gmap;
7468   PetscInt*              l2gmap_indices;
7469   const PetscInt*        is_indices;
7470   MatType                new_local_type;
7471   /* buffers */
7472   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7473   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7474   PetscInt               *recv_buffer_idxs_local;
7475   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7476   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7477   /* MPI */
7478   MPI_Comm               comm,comm_n;
7479   PetscSubcomm           subcomm;
7480   PetscMPIInt            n_sends,n_recvs,size;
7481   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7482   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7483   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7484   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7485   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7486   PetscErrorCode         ierr;
7487 
7488   PetscFunctionBegin;
7489   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7490   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7491   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);
7492   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7493   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7494   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7495   PetscValidLogicalCollectiveBool(mat,reuse,6);
7496   PetscValidLogicalCollectiveInt(mat,nis,8);
7497   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7498   if (nvecs) {
7499     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7500     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7501   }
7502   /* further checks */
7503   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7504   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7505   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7506   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7507   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7508   if (reuse && *mat_n) {
7509     PetscInt mrows,mcols,mnrows,mncols;
7510     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7511     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7512     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7513     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7514     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7515     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7516     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7517   }
7518   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7519   PetscValidLogicalCollectiveInt(mat,bs,0);
7520 
7521   /* prepare IS for sending if not provided */
7522   if (!is_sends) {
7523     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7524     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7525   } else {
7526     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7527     is_sends_internal = is_sends;
7528   }
7529 
7530   /* get comm */
7531   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7532 
7533   /* compute number of sends */
7534   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7535   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7536 
7537   /* compute number of receives */
7538   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7539   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7540   ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
7541   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7542   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7543   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7544   ierr = PetscFree(iflags);CHKERRQ(ierr);
7545 
7546   /* restrict comm if requested */
7547   subcomm = 0;
7548   destroy_mat = PETSC_FALSE;
7549   if (restrict_comm) {
7550     PetscMPIInt color,subcommsize;
7551 
7552     color = 0;
7553     if (restrict_full) {
7554       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7555     } else {
7556       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7557     }
7558     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7559     subcommsize = size - subcommsize;
7560     /* check if reuse has been requested */
7561     if (reuse) {
7562       if (*mat_n) {
7563         PetscMPIInt subcommsize2;
7564         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7565         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7566         comm_n = PetscObjectComm((PetscObject)*mat_n);
7567       } else {
7568         comm_n = PETSC_COMM_SELF;
7569       }
7570     } else { /* MAT_INITIAL_MATRIX */
7571       PetscMPIInt rank;
7572 
7573       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7574       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7575       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7576       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7577       comm_n = PetscSubcommChild(subcomm);
7578     }
7579     /* flag to destroy *mat_n if not significative */
7580     if (color) destroy_mat = PETSC_TRUE;
7581   } else {
7582     comm_n = comm;
7583   }
7584 
7585   /* prepare send/receive buffers */
7586   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7587   ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7588   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7589   ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr);
7590   if (nis) {
7591     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7592   }
7593 
7594   /* Get data from local matrices */
7595   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7596     /* TODO: See below some guidelines on how to prepare the local buffers */
7597     /*
7598        send_buffer_vals should contain the raw values of the local matrix
7599        send_buffer_idxs should contain:
7600        - MatType_PRIVATE type
7601        - PetscInt        size_of_l2gmap
7602        - PetscInt        global_row_indices[size_of_l2gmap]
7603        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7604     */
7605   else {
7606     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7607     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7608     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7609     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7610     send_buffer_idxs[1] = i;
7611     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7612     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7613     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7614     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7615     for (i=0;i<n_sends;i++) {
7616       ilengths_vals[is_indices[i]] = len*len;
7617       ilengths_idxs[is_indices[i]] = len+2;
7618     }
7619   }
7620   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7621   /* additional is (if any) */
7622   if (nis) {
7623     PetscMPIInt psum;
7624     PetscInt j;
7625     for (j=0,psum=0;j<nis;j++) {
7626       PetscInt plen;
7627       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7628       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7629       psum += len+1; /* indices + lenght */
7630     }
7631     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7632     for (j=0,psum=0;j<nis;j++) {
7633       PetscInt plen;
7634       const PetscInt *is_array_idxs;
7635       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7636       send_buffer_idxs_is[psum] = plen;
7637       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7638       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7639       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7640       psum += plen+1; /* indices + lenght */
7641     }
7642     for (i=0;i<n_sends;i++) {
7643       ilengths_idxs_is[is_indices[i]] = psum;
7644     }
7645     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7646   }
7647   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7648 
7649   buf_size_idxs = 0;
7650   buf_size_vals = 0;
7651   buf_size_idxs_is = 0;
7652   buf_size_vecs = 0;
7653   for (i=0;i<n_recvs;i++) {
7654     buf_size_idxs += (PetscInt)olengths_idxs[i];
7655     buf_size_vals += (PetscInt)olengths_vals[i];
7656     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7657     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7658   }
7659   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7660   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7661   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7662   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7663 
7664   /* get new tags for clean communications */
7665   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7666   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7667   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7668   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7669 
7670   /* allocate for requests */
7671   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7672   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7673   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7674   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7675   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7676   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7677   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7678   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7679 
7680   /* communications */
7681   ptr_idxs = recv_buffer_idxs;
7682   ptr_vals = recv_buffer_vals;
7683   ptr_idxs_is = recv_buffer_idxs_is;
7684   ptr_vecs = recv_buffer_vecs;
7685   for (i=0;i<n_recvs;i++) {
7686     source_dest = onodes[i];
7687     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7688     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7689     ptr_idxs += olengths_idxs[i];
7690     ptr_vals += olengths_vals[i];
7691     if (nis) {
7692       source_dest = onodes_is[i];
7693       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);
7694       ptr_idxs_is += olengths_idxs_is[i];
7695     }
7696     if (nvecs) {
7697       source_dest = onodes[i];
7698       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7699       ptr_vecs += olengths_idxs[i]-2;
7700     }
7701   }
7702   for (i=0;i<n_sends;i++) {
7703     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7704     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7705     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7706     if (nis) {
7707       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);
7708     }
7709     if (nvecs) {
7710       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7711       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7712     }
7713   }
7714   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7715   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7716 
7717   /* assemble new l2g map */
7718   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7719   ptr_idxs = recv_buffer_idxs;
7720   new_local_rows = 0;
7721   for (i=0;i<n_recvs;i++) {
7722     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7723     ptr_idxs += olengths_idxs[i];
7724   }
7725   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7726   ptr_idxs = recv_buffer_idxs;
7727   new_local_rows = 0;
7728   for (i=0;i<n_recvs;i++) {
7729     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7730     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7731     ptr_idxs += olengths_idxs[i];
7732   }
7733   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7734   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7735   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7736 
7737   /* infer new local matrix type from received local matrices type */
7738   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7739   /* 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) */
7740   if (n_recvs) {
7741     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7742     ptr_idxs = recv_buffer_idxs;
7743     for (i=0;i<n_recvs;i++) {
7744       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7745         new_local_type_private = MATAIJ_PRIVATE;
7746         break;
7747       }
7748       ptr_idxs += olengths_idxs[i];
7749     }
7750     switch (new_local_type_private) {
7751       case MATDENSE_PRIVATE:
7752         new_local_type = MATSEQAIJ;
7753         bs = 1;
7754         break;
7755       case MATAIJ_PRIVATE:
7756         new_local_type = MATSEQAIJ;
7757         bs = 1;
7758         break;
7759       case MATBAIJ_PRIVATE:
7760         new_local_type = MATSEQBAIJ;
7761         break;
7762       case MATSBAIJ_PRIVATE:
7763         new_local_type = MATSEQSBAIJ;
7764         break;
7765       default:
7766         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7767         break;
7768     }
7769   } else { /* by default, new_local_type is seqaij */
7770     new_local_type = MATSEQAIJ;
7771     bs = 1;
7772   }
7773 
7774   /* create MATIS object if needed */
7775   if (!reuse) {
7776     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7777     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7778   } else {
7779     /* it also destroys the local matrices */
7780     if (*mat_n) {
7781       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7782     } else { /* this is a fake object */
7783       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7784     }
7785   }
7786   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7787   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7788 
7789   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7790 
7791   /* Global to local map of received indices */
7792   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7793   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7794   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7795 
7796   /* restore attributes -> type of incoming data and its size */
7797   buf_size_idxs = 0;
7798   for (i=0;i<n_recvs;i++) {
7799     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7800     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7801     buf_size_idxs += (PetscInt)olengths_idxs[i];
7802   }
7803   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7804 
7805   /* set preallocation */
7806   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7807   if (!newisdense) {
7808     PetscInt *new_local_nnz=0;
7809 
7810     ptr_idxs = recv_buffer_idxs_local;
7811     if (n_recvs) {
7812       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7813     }
7814     for (i=0;i<n_recvs;i++) {
7815       PetscInt j;
7816       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7817         for (j=0;j<*(ptr_idxs+1);j++) {
7818           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7819         }
7820       } else {
7821         /* TODO */
7822       }
7823       ptr_idxs += olengths_idxs[i];
7824     }
7825     if (new_local_nnz) {
7826       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7827       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7828       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7829       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7830       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7831       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7832     } else {
7833       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7834     }
7835     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7836   } else {
7837     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7838   }
7839 
7840   /* set values */
7841   ptr_vals = recv_buffer_vals;
7842   ptr_idxs = recv_buffer_idxs_local;
7843   for (i=0;i<n_recvs;i++) {
7844     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7845       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7846       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7847       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7848       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7849       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7850     } else {
7851       /* TODO */
7852     }
7853     ptr_idxs += olengths_idxs[i];
7854     ptr_vals += olengths_vals[i];
7855   }
7856   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7857   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7858   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7859   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7860   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7861   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7862 
7863 #if 0
7864   if (!restrict_comm) { /* check */
7865     Vec       lvec,rvec;
7866     PetscReal infty_error;
7867 
7868     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7869     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7870     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7871     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7872     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7873     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7874     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7875     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7876     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7877   }
7878 #endif
7879 
7880   /* assemble new additional is (if any) */
7881   if (nis) {
7882     PetscInt **temp_idxs,*count_is,j,psum;
7883 
7884     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7885     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7886     ptr_idxs = recv_buffer_idxs_is;
7887     psum = 0;
7888     for (i=0;i<n_recvs;i++) {
7889       for (j=0;j<nis;j++) {
7890         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7891         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7892         psum += plen;
7893         ptr_idxs += plen+1; /* shift pointer to received data */
7894       }
7895     }
7896     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7897     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7898     for (i=1;i<nis;i++) {
7899       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7900     }
7901     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7902     ptr_idxs = recv_buffer_idxs_is;
7903     for (i=0;i<n_recvs;i++) {
7904       for (j=0;j<nis;j++) {
7905         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7906         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7907         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7908         ptr_idxs += plen+1; /* shift pointer to received data */
7909       }
7910     }
7911     for (i=0;i<nis;i++) {
7912       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7913       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7914       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7915     }
7916     ierr = PetscFree(count_is);CHKERRQ(ierr);
7917     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7918     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7919   }
7920   /* free workspace */
7921   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7922   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7923   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7924   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7925   if (isdense) {
7926     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7927     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7928     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7929   } else {
7930     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7931   }
7932   if (nis) {
7933     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7934     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7935   }
7936 
7937   if (nvecs) {
7938     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7939     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7940     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7941     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7942     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7943     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7944     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7945     /* set values */
7946     ptr_vals = recv_buffer_vecs;
7947     ptr_idxs = recv_buffer_idxs_local;
7948     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7949     for (i=0;i<n_recvs;i++) {
7950       PetscInt j;
7951       for (j=0;j<*(ptr_idxs+1);j++) {
7952         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7953       }
7954       ptr_idxs += olengths_idxs[i];
7955       ptr_vals += olengths_idxs[i]-2;
7956     }
7957     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7958     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7959     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7960   }
7961 
7962   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7963   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7964   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7965   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7966   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7967   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7968   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7969   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7970   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7971   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7972   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7973   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7974   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7975   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7976   ierr = PetscFree(onodes);CHKERRQ(ierr);
7977   if (nis) {
7978     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7979     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7980     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7981   }
7982   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7983   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7984     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7985     for (i=0;i<nis;i++) {
7986       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7987     }
7988     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7989       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7990     }
7991     *mat_n = NULL;
7992   }
7993   PetscFunctionReturn(0);
7994 }
7995 
7996 /* temporary hack into ksp private data structure */
7997 #include <petsc/private/kspimpl.h>
7998 
7999 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8000 {
8001   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8002   PC_IS                  *pcis = (PC_IS*)pc->data;
8003   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8004   Mat                    coarsedivudotp = NULL;
8005   Mat                    coarseG,t_coarse_mat_is;
8006   MatNullSpace           CoarseNullSpace = NULL;
8007   ISLocalToGlobalMapping coarse_islg;
8008   IS                     coarse_is,*isarray,corners;
8009   PetscInt               i,im_active=-1,active_procs=-1;
8010   PetscInt               nis,nisdofs,nisneu,nisvert;
8011   PetscInt               coarse_eqs_per_proc;
8012   PC                     pc_temp;
8013   PCType                 coarse_pc_type;
8014   KSPType                coarse_ksp_type;
8015   PetscBool              multilevel_requested,multilevel_allowed;
8016   PetscBool              coarse_reuse;
8017   PetscInt               ncoarse,nedcfield;
8018   PetscBool              compute_vecs = PETSC_FALSE;
8019   PetscScalar            *array;
8020   MatReuse               coarse_mat_reuse;
8021   PetscBool              restr, full_restr, have_void;
8022   PetscMPIInt            size;
8023   PetscErrorCode         ierr;
8024 
8025   PetscFunctionBegin;
8026   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8027   /* Assign global numbering to coarse dofs */
8028   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 */
8029     PetscInt ocoarse_size;
8030     compute_vecs = PETSC_TRUE;
8031 
8032     pcbddc->new_primal_space = PETSC_TRUE;
8033     ocoarse_size = pcbddc->coarse_size;
8034     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8035     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8036     /* see if we can avoid some work */
8037     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8038       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8039       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8040         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8041         coarse_reuse = PETSC_FALSE;
8042       } else { /* we can safely reuse already computed coarse matrix */
8043         coarse_reuse = PETSC_TRUE;
8044       }
8045     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8046       coarse_reuse = PETSC_FALSE;
8047     }
8048     /* reset any subassembling information */
8049     if (!coarse_reuse || pcbddc->recompute_topography) {
8050       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8051     }
8052   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8053     coarse_reuse = PETSC_TRUE;
8054   }
8055   if (coarse_reuse && pcbddc->coarse_ksp) {
8056     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8057     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8058     coarse_mat_reuse = MAT_REUSE_MATRIX;
8059   } else {
8060     coarse_mat = NULL;
8061     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8062   }
8063 
8064   /* creates temporary l2gmap and IS for coarse indexes */
8065   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8066   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8067 
8068   /* creates temporary MATIS object for coarse matrix */
8069   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8070   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);
8071   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8072   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8073   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8074   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8075 
8076   /* count "active" (i.e. with positive local size) and "void" processes */
8077   im_active = !!(pcis->n);
8078   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8079 
8080   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8081   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8082   /* full_restr : just use the receivers from the subassembling pattern */
8083   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8084   coarse_mat_is        = NULL;
8085   multilevel_allowed   = PETSC_FALSE;
8086   multilevel_requested = PETSC_FALSE;
8087   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8088   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8089   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8090   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8091   if (multilevel_requested) {
8092     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8093     restr      = PETSC_FALSE;
8094     full_restr = PETSC_FALSE;
8095   } else {
8096     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8097     restr      = PETSC_TRUE;
8098     full_restr = PETSC_TRUE;
8099   }
8100   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8101   ncoarse = PetscMax(1,ncoarse);
8102   if (!pcbddc->coarse_subassembling) {
8103     if (pcbddc->coarsening_ratio > 1) {
8104       if (multilevel_requested) {
8105         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8106       } else {
8107         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8108       }
8109     } else {
8110       PetscMPIInt rank;
8111       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8112       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8113       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8114     }
8115   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8116     PetscInt    psum;
8117     if (pcbddc->coarse_ksp) psum = 1;
8118     else psum = 0;
8119     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8120     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8121   }
8122   /* determine if we can go multilevel */
8123   if (multilevel_requested) {
8124     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8125     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8126   }
8127   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8128 
8129   /* dump subassembling pattern */
8130   if (pcbddc->dbg_flag && multilevel_allowed) {
8131     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8132   }
8133   /* compute dofs splitting and neumann boundaries for coarse dofs */
8134   nedcfield = -1;
8135   corners = NULL;
8136   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneded computations */
8137     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8138     const PetscInt         *idxs;
8139     ISLocalToGlobalMapping tmap;
8140 
8141     /* create map between primal indices (in local representative ordering) and local primal numbering */
8142     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8143     /* allocate space for temporary storage */
8144     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8145     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8146     /* allocate for IS array */
8147     nisdofs = pcbddc->n_ISForDofsLocal;
8148     if (pcbddc->nedclocal) {
8149       if (pcbddc->nedfield > -1) {
8150         nedcfield = pcbddc->nedfield;
8151       } else {
8152         nedcfield = 0;
8153         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8154         nisdofs = 1;
8155       }
8156     }
8157     nisneu = !!pcbddc->NeumannBoundariesLocal;
8158     nisvert = 0; /* nisvert is not used */
8159     nis = nisdofs + nisneu + nisvert;
8160     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8161     /* dofs splitting */
8162     for (i=0;i<nisdofs;i++) {
8163       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8164       if (nedcfield != i) {
8165         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8166         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8167         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8168         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8169       } else {
8170         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8171         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8172         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8173         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8174         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8175       }
8176       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8177       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8178       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8179     }
8180     /* neumann boundaries */
8181     if (pcbddc->NeumannBoundariesLocal) {
8182       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8183       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8184       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8185       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8186       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8187       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8188       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8189       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8190     }
8191     /* coordinates */
8192     if (pcbddc->corner_selected) {
8193       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8194       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8195       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8196       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8197       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8198       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8199       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8200       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8201       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8202     }
8203     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8204     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8205     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8206   } else {
8207     nis = 0;
8208     nisdofs = 0;
8209     nisneu = 0;
8210     nisvert = 0;
8211     isarray = NULL;
8212   }
8213   /* destroy no longer needed map */
8214   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8215 
8216   /* subassemble */
8217   if (multilevel_allowed) {
8218     Vec       vp[1];
8219     PetscInt  nvecs = 0;
8220     PetscBool reuse,reuser;
8221 
8222     if (coarse_mat) reuse = PETSC_TRUE;
8223     else reuse = PETSC_FALSE;
8224     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8225     vp[0] = NULL;
8226     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8227       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8228       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8229       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8230       nvecs = 1;
8231 
8232       if (pcbddc->divudotp) {
8233         Mat      B,loc_divudotp;
8234         Vec      v,p;
8235         IS       dummy;
8236         PetscInt np;
8237 
8238         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8239         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8240         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8241         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8242         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8243         ierr = VecSet(p,1.);CHKERRQ(ierr);
8244         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8245         ierr = VecDestroy(&p);CHKERRQ(ierr);
8246         ierr = MatDestroy(&B);CHKERRQ(ierr);
8247         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8248         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8249         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8250         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8251         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8252         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8253         ierr = VecDestroy(&v);CHKERRQ(ierr);
8254       }
8255     }
8256     if (reuser) {
8257       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8258     } else {
8259       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8260     }
8261     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8262       PetscScalar *arraym,*arrayv;
8263       PetscInt    nl;
8264       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8265       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8266       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8267       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8268       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8269       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8270       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8271       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8272     } else {
8273       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8274     }
8275   } else {
8276     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8277   }
8278   if (coarse_mat_is || coarse_mat) {
8279     if (!multilevel_allowed) {
8280       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8281     } else {
8282       Mat A;
8283 
8284       /* if this matrix is present, it means we are not reusing the coarse matrix */
8285       if (coarse_mat_is) {
8286         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8287         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8288         coarse_mat = coarse_mat_is;
8289       }
8290       /* be sure we don't have MatSeqDENSE as local mat */
8291       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8292       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8293     }
8294   }
8295   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8296   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8297 
8298   /* create local to global scatters for coarse problem */
8299   if (compute_vecs) {
8300     PetscInt lrows;
8301     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8302     if (coarse_mat) {
8303       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8304     } else {
8305       lrows = 0;
8306     }
8307     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8308     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8309     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8310     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8311     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8312   }
8313   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8314 
8315   /* set defaults for coarse KSP and PC */
8316   if (multilevel_allowed) {
8317     coarse_ksp_type = KSPRICHARDSON;
8318     coarse_pc_type  = PCBDDC;
8319   } else {
8320     coarse_ksp_type = KSPPREONLY;
8321     coarse_pc_type  = PCREDUNDANT;
8322   }
8323 
8324   /* print some info if requested */
8325   if (pcbddc->dbg_flag) {
8326     if (!multilevel_allowed) {
8327       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8328       if (multilevel_requested) {
8329         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);
8330       } else if (pcbddc->max_levels) {
8331         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8332       }
8333       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8334     }
8335   }
8336 
8337   /* communicate coarse discrete gradient */
8338   coarseG = NULL;
8339   if (pcbddc->nedcG && multilevel_allowed) {
8340     MPI_Comm ccomm;
8341     if (coarse_mat) {
8342       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8343     } else {
8344       ccomm = MPI_COMM_NULL;
8345     }
8346     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8347   }
8348 
8349   /* create the coarse KSP object only once with defaults */
8350   if (coarse_mat) {
8351     PetscBool   isredundant,isnn,isbddc;
8352     PetscViewer dbg_viewer = NULL;
8353 
8354     if (pcbddc->dbg_flag) {
8355       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8356       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8357     }
8358     if (!pcbddc->coarse_ksp) {
8359       char   prefix[256],str_level[16];
8360       size_t len;
8361 
8362       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8363       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8364       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8365       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8366       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8367       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8368       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8369       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8370       /* TODO is this logic correct? should check for coarse_mat type */
8371       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8372       /* prefix */
8373       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8374       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8375       if (!pcbddc->current_level) {
8376         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8377         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8378       } else {
8379         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8380         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8381         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8382         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8383         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8384         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8385         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8386       }
8387       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8388       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8389       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8390       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8391       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8392       /* allow user customization */
8393       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8394       /* get some info after set from options */
8395       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8396       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8397       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8398       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8399       if (multilevel_allowed && !isbddc && !isnn) {
8400         isbddc = PETSC_TRUE;
8401         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8402         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8403         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8404         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8405         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8406           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8407           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8408           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8409           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8410           pc_temp->setfromoptionscalled++;
8411         }
8412       }
8413     }
8414     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8415     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8416     if (nisdofs) {
8417       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8418       for (i=0;i<nisdofs;i++) {
8419         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8420       }
8421     }
8422     if (nisneu) {
8423       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8424       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8425     }
8426     if (nisvert) {
8427       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8428       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8429     }
8430     if (coarseG) {
8431       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8432     }
8433 
8434     /* get some info after set from options */
8435     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8436 
8437     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8438     if (isbddc && !multilevel_allowed) {
8439       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8440       isbddc = PETSC_FALSE;
8441     }
8442     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8443     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8444     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8445       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8446       isbddc = PETSC_TRUE;
8447     }
8448     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8449     if (isredundant) {
8450       KSP inner_ksp;
8451       PC  inner_pc;
8452 
8453       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8454       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8455     }
8456 
8457     /* parameters which miss an API */
8458     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8459     if (isbddc) {
8460       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8461 
8462       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8463       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8464       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8465       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8466       if (pcbddc_coarse->benign_saddle_point) {
8467         Mat                    coarsedivudotp_is;
8468         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8469         IS                     row,col;
8470         const PetscInt         *gidxs;
8471         PetscInt               n,st,M,N;
8472 
8473         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8474         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8475         st   = st-n;
8476         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8477         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8478         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8479         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8480         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8481         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8482         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8483         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8484         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8485         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8486         ierr = ISDestroy(&row);CHKERRQ(ierr);
8487         ierr = ISDestroy(&col);CHKERRQ(ierr);
8488         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8489         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8490         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8491         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8492         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8493         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8494         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8495         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8496         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8497         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8498         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8499         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8500       }
8501     }
8502 
8503     /* propagate symmetry info of coarse matrix */
8504     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8505     if (pc->pmat->symmetric_set) {
8506       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8507     }
8508     if (pc->pmat->hermitian_set) {
8509       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8510     }
8511     if (pc->pmat->spd_set) {
8512       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8513     }
8514     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8515       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8516     }
8517     /* set operators */
8518     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8519     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8520     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8521     if (pcbddc->dbg_flag) {
8522       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8523     }
8524   }
8525   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8526   ierr = PetscFree(isarray);CHKERRQ(ierr);
8527 #if 0
8528   {
8529     PetscViewer viewer;
8530     char filename[256];
8531     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8532     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8533     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8534     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8535     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8536     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8537   }
8538 #endif
8539 
8540   if (corners) {
8541     Vec            gv;
8542     IS             is;
8543     const PetscInt *idxs;
8544     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8545     PetscScalar    *coords;
8546 
8547     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8548     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8549     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8550     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8551     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8552     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8553     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8554     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8555     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8556 
8557     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8558     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8559     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8560     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8561     for (i=0;i<n;i++) {
8562       for (d=0;d<cdim;d++) {
8563         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8564       }
8565     }
8566     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8567     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8568 
8569     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8570     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8571     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8572     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8573     ierr = PetscFree(coords);CHKERRQ(ierr);
8574     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8575     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8576     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8577     if (pcbddc->coarse_ksp) {
8578       PC        coarse_pc;
8579       PetscBool isbddc;
8580 
8581       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8582       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8583       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8584         PetscReal *realcoords;
8585 
8586         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8587 #if defined(PETSC_USE_COMPLEX)
8588         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8589         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8590 #else
8591         realcoords = coords;
8592 #endif
8593         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8594 #if defined(PETSC_USE_COMPLEX)
8595         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8596 #endif
8597       }
8598     }
8599     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8600     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8601   }
8602   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8603 
8604   if (pcbddc->coarse_ksp) {
8605     Vec crhs,csol;
8606 
8607     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8608     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8609     if (!csol) {
8610       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8611     }
8612     if (!crhs) {
8613       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8614     }
8615   }
8616   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8617 
8618   /* compute null space for coarse solver if the benign trick has been requested */
8619   if (pcbddc->benign_null) {
8620 
8621     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8622     for (i=0;i<pcbddc->benign_n;i++) {
8623       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8624     }
8625     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8626     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8627     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8628     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8629     if (coarse_mat) {
8630       Vec         nullv;
8631       PetscScalar *array,*array2;
8632       PetscInt    nl;
8633 
8634       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8635       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8636       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8637       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8638       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8639       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8640       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8641       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8642       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8643       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8644     }
8645   }
8646   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8647 
8648   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8649   if (pcbddc->coarse_ksp) {
8650     PetscBool ispreonly;
8651 
8652     if (CoarseNullSpace) {
8653       PetscBool isnull;
8654       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8655       if (isnull) {
8656         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8657       }
8658       /* TODO: add local nullspaces (if any) */
8659     }
8660     /* setup coarse ksp */
8661     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8662     /* Check coarse problem if in debug mode or if solving with an iterative method */
8663     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8664     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8665       KSP       check_ksp;
8666       KSPType   check_ksp_type;
8667       PC        check_pc;
8668       Vec       check_vec,coarse_vec;
8669       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8670       PetscInt  its;
8671       PetscBool compute_eigs;
8672       PetscReal *eigs_r,*eigs_c;
8673       PetscInt  neigs;
8674       const char *prefix;
8675 
8676       /* Create ksp object suitable for estimation of extreme eigenvalues */
8677       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8678       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8679       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8680       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8681       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8682       /* prevent from setup unneeded object */
8683       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8684       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8685       if (ispreonly) {
8686         check_ksp_type = KSPPREONLY;
8687         compute_eigs = PETSC_FALSE;
8688       } else {
8689         check_ksp_type = KSPGMRES;
8690         compute_eigs = PETSC_TRUE;
8691       }
8692       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8693       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8694       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8695       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8696       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8697       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8698       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8699       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8700       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8701       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8702       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8703       /* create random vec */
8704       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8705       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8706       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8707       /* solve coarse problem */
8708       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8709       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8710       /* set eigenvalue estimation if preonly has not been requested */
8711       if (compute_eigs) {
8712         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8713         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8714         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8715         if (neigs) {
8716           lambda_max = eigs_r[neigs-1];
8717           lambda_min = eigs_r[0];
8718           if (pcbddc->use_coarse_estimates) {
8719             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8720               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8721               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8722             }
8723           }
8724         }
8725       }
8726 
8727       /* check coarse problem residual error */
8728       if (pcbddc->dbg_flag) {
8729         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8730         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8731         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8732         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8733         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8734         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8735         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8736         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8737         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8738         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8739         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8740         if (CoarseNullSpace) {
8741           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8742         }
8743         if (compute_eigs) {
8744           PetscReal          lambda_max_s,lambda_min_s;
8745           KSPConvergedReason reason;
8746           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8747           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8748           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8749           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8750           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);
8751           for (i=0;i<neigs;i++) {
8752             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8753           }
8754         }
8755         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8756         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8757       }
8758       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8759       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8760       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8761       if (compute_eigs) {
8762         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8763         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8764       }
8765     }
8766   }
8767   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8768   /* print additional info */
8769   if (pcbddc->dbg_flag) {
8770     /* waits until all processes reaches this point */
8771     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8772     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8773     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8774   }
8775 
8776   /* free memory */
8777   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8778   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8779   PetscFunctionReturn(0);
8780 }
8781 
8782 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8783 {
8784   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8785   PC_IS*         pcis = (PC_IS*)pc->data;
8786   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8787   IS             subset,subset_mult,subset_n;
8788   PetscInt       local_size,coarse_size=0;
8789   PetscInt       *local_primal_indices=NULL;
8790   const PetscInt *t_local_primal_indices;
8791   PetscErrorCode ierr;
8792 
8793   PetscFunctionBegin;
8794   /* Compute global number of coarse dofs */
8795   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8796   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8797   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8798   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8799   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8800   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8801   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8802   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8803   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8804   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);
8805   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8806   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8807   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8808   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8809   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8810 
8811   /* check numbering */
8812   if (pcbddc->dbg_flag) {
8813     PetscScalar coarsesum,*array,*array2;
8814     PetscInt    i;
8815     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8816 
8817     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8818     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8819     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8820     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8821     /* counter */
8822     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8823     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8824     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8825     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8826     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8827     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8828     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8829     for (i=0;i<pcbddc->local_primal_size;i++) {
8830       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8831     }
8832     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8833     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8834     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8835     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8836     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8837     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8838     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8839     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8840     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8841     for (i=0;i<pcis->n;i++) {
8842       if (array[i] != 0.0 && array[i] != array2[i]) {
8843         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8844         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8845         set_error = PETSC_TRUE;
8846         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8847         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);
8848       }
8849     }
8850     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8851     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8852     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8853     for (i=0;i<pcis->n;i++) {
8854       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8855     }
8856     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8857     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8858     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8859     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8860     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8861     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8862     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8863       PetscInt *gidxs;
8864 
8865       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8866       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8867       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8868       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8869       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8870       for (i=0;i<pcbddc->local_primal_size;i++) {
8871         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);
8872       }
8873       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8874       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8875     }
8876     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8877     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8878     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8879   }
8880 
8881   /* get back data */
8882   *coarse_size_n = coarse_size;
8883   *local_primal_indices_n = local_primal_indices;
8884   PetscFunctionReturn(0);
8885 }
8886 
8887 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8888 {
8889   IS             localis_t;
8890   PetscInt       i,lsize,*idxs,n;
8891   PetscScalar    *vals;
8892   PetscErrorCode ierr;
8893 
8894   PetscFunctionBegin;
8895   /* get indices in local ordering exploiting local to global map */
8896   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8897   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8898   for (i=0;i<lsize;i++) vals[i] = 1.0;
8899   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8900   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8901   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8902   if (idxs) { /* multilevel guard */
8903     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8904     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8905   }
8906   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8907   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8908   ierr = PetscFree(vals);CHKERRQ(ierr);
8909   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8910   /* now compute set in local ordering */
8911   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8912   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8913   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8914   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8915   for (i=0,lsize=0;i<n;i++) {
8916     if (PetscRealPart(vals[i]) > 0.5) {
8917       lsize++;
8918     }
8919   }
8920   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8921   for (i=0,lsize=0;i<n;i++) {
8922     if (PetscRealPart(vals[i]) > 0.5) {
8923       idxs[lsize++] = i;
8924     }
8925   }
8926   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8927   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8928   *localis = localis_t;
8929   PetscFunctionReturn(0);
8930 }
8931 
8932 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8933 {
8934   PC_IS               *pcis=(PC_IS*)pc->data;
8935   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8936   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8937   Mat                 S_j;
8938   PetscInt            *used_xadj,*used_adjncy;
8939   PetscBool           free_used_adj;
8940   PetscErrorCode      ierr;
8941 
8942   PetscFunctionBegin;
8943   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8944   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8945   free_used_adj = PETSC_FALSE;
8946   if (pcbddc->sub_schurs_layers == -1) {
8947     used_xadj = NULL;
8948     used_adjncy = NULL;
8949   } else {
8950     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8951       used_xadj = pcbddc->mat_graph->xadj;
8952       used_adjncy = pcbddc->mat_graph->adjncy;
8953     } else if (pcbddc->computed_rowadj) {
8954       used_xadj = pcbddc->mat_graph->xadj;
8955       used_adjncy = pcbddc->mat_graph->adjncy;
8956     } else {
8957       PetscBool      flg_row=PETSC_FALSE;
8958       const PetscInt *xadj,*adjncy;
8959       PetscInt       nvtxs;
8960 
8961       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8962       if (flg_row) {
8963         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8964         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8965         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8966         free_used_adj = PETSC_TRUE;
8967       } else {
8968         pcbddc->sub_schurs_layers = -1;
8969         used_xadj = NULL;
8970         used_adjncy = NULL;
8971       }
8972       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8973     }
8974   }
8975 
8976   /* setup sub_schurs data */
8977   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8978   if (!sub_schurs->schur_explicit) {
8979     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8980     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8981     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);
8982   } else {
8983     Mat       change = NULL;
8984     Vec       scaling = NULL;
8985     IS        change_primal = NULL, iP;
8986     PetscInt  benign_n;
8987     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8988     PetscBool isseqaij,need_change = PETSC_FALSE;
8989     PetscBool discrete_harmonic = PETSC_FALSE;
8990 
8991     if (!pcbddc->use_vertices && reuse_solvers) {
8992       PetscInt n_vertices;
8993 
8994       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8995       reuse_solvers = (PetscBool)!n_vertices;
8996     }
8997     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8998     if (!isseqaij) {
8999       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
9000       if (matis->A == pcbddc->local_mat) {
9001         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
9002         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9003       } else {
9004         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9005       }
9006     }
9007     if (!pcbddc->benign_change_explicit) {
9008       benign_n = pcbddc->benign_n;
9009     } else {
9010       benign_n = 0;
9011     }
9012     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9013        We need a global reduction to avoid possible deadlocks.
9014        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9015     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9016       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9017       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9018       need_change = (PetscBool)(!need_change);
9019     }
9020     /* If the user defines additional constraints, we import them here.
9021        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 */
9022     if (need_change) {
9023       PC_IS   *pcisf;
9024       PC_BDDC *pcbddcf;
9025       PC      pcf;
9026 
9027       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9028       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9029       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9030       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9031 
9032       /* hacks */
9033       pcisf                        = (PC_IS*)pcf->data;
9034       pcisf->is_B_local            = pcis->is_B_local;
9035       pcisf->vec1_N                = pcis->vec1_N;
9036       pcisf->BtoNmap               = pcis->BtoNmap;
9037       pcisf->n                     = pcis->n;
9038       pcisf->n_B                   = pcis->n_B;
9039       pcbddcf                      = (PC_BDDC*)pcf->data;
9040       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9041       pcbddcf->mat_graph           = pcbddc->mat_graph;
9042       pcbddcf->use_faces           = PETSC_TRUE;
9043       pcbddcf->use_change_of_basis = PETSC_TRUE;
9044       pcbddcf->use_change_on_faces = PETSC_TRUE;
9045       pcbddcf->use_qr_single       = PETSC_TRUE;
9046       pcbddcf->fake_change         = PETSC_TRUE;
9047 
9048       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9049       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9050       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9051       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9052       change = pcbddcf->ConstraintMatrix;
9053       pcbddcf->ConstraintMatrix = NULL;
9054 
9055       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9056       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9057       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9058       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9059       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9060       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9061       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9062       pcf->ops->destroy = NULL;
9063       pcf->ops->reset   = NULL;
9064       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9065     }
9066     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9067 
9068     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9069     if (iP) {
9070       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9071       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9072       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9073     }
9074     if (discrete_harmonic) {
9075       Mat A;
9076       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9077       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9078       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9079       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);
9080       ierr = MatDestroy(&A);CHKERRQ(ierr);
9081     } else {
9082       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);
9083     }
9084     ierr = MatDestroy(&change);CHKERRQ(ierr);
9085     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9086   }
9087   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9088 
9089   /* free adjacency */
9090   if (free_used_adj) {
9091     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9092   }
9093   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9094   PetscFunctionReturn(0);
9095 }
9096 
9097 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9098 {
9099   PC_IS               *pcis=(PC_IS*)pc->data;
9100   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9101   PCBDDCGraph         graph;
9102   PetscErrorCode      ierr;
9103 
9104   PetscFunctionBegin;
9105   /* attach interface graph for determining subsets */
9106   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9107     IS       verticesIS,verticescomm;
9108     PetscInt vsize,*idxs;
9109 
9110     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9111     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9112     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9113     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9114     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9115     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9116     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9117     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9118     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9119     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9120     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9121   } else {
9122     graph = pcbddc->mat_graph;
9123   }
9124   /* print some info */
9125   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9126     IS       vertices;
9127     PetscInt nv,nedges,nfaces;
9128     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9129     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9130     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9131     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9132     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9133     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9134     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9135     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9136     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9137     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9138     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9139   }
9140 
9141   /* sub_schurs init */
9142   if (!pcbddc->sub_schurs) {
9143     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9144   }
9145   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);
9146 
9147   /* free graph struct */
9148   if (pcbddc->sub_schurs_rebuild) {
9149     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9150   }
9151   PetscFunctionReturn(0);
9152 }
9153 
9154 PetscErrorCode PCBDDCCheckOperator(PC pc)
9155 {
9156   PC_IS               *pcis=(PC_IS*)pc->data;
9157   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9158   PetscErrorCode      ierr;
9159 
9160   PetscFunctionBegin;
9161   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9162     IS             zerodiag = NULL;
9163     Mat            S_j,B0_B=NULL;
9164     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9165     PetscScalar    *p0_check,*array,*array2;
9166     PetscReal      norm;
9167     PetscInt       i;
9168 
9169     /* B0 and B0_B */
9170     if (zerodiag) {
9171       IS       dummy;
9172 
9173       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9174       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9175       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9176       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9177     }
9178     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9179     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9180     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9181     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9182     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9183     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9184     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9185     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9186     /* S_j */
9187     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9188     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9189 
9190     /* mimic vector in \widetilde{W}_\Gamma */
9191     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9192     /* continuous in primal space */
9193     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9194     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9195     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9196     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9197     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9198     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9199     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9200     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9201     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9202     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9203     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9204     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9205     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9206     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9207 
9208     /* assemble rhs for coarse problem */
9209     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9210     /* local with Schur */
9211     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9212     if (zerodiag) {
9213       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9214       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9215       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9216       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9217     }
9218     /* sum on primal nodes the local contributions */
9219     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9220     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9221     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9222     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9223     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9224     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9225     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9226     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9227     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9228     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9229     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9230     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9231     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9232     /* scale primal nodes (BDDC sums contibutions) */
9233     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9234     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9235     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9236     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9237     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9238     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9239     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9240     /* global: \widetilde{B0}_B w_\Gamma */
9241     if (zerodiag) {
9242       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9243       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9244       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9245       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9246     }
9247     /* BDDC */
9248     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9249     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9250 
9251     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9252     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9253     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9254     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9255     for (i=0;i<pcbddc->benign_n;i++) {
9256       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);
9257     }
9258     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9259     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9260     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9261     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9262     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9263     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9264   }
9265   PetscFunctionReturn(0);
9266 }
9267 
9268 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9269 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9270 {
9271   Mat            At;
9272   IS             rows;
9273   PetscInt       rst,ren;
9274   PetscErrorCode ierr;
9275   PetscLayout    rmap;
9276 
9277   PetscFunctionBegin;
9278   rst = ren = 0;
9279   if (ccomm != MPI_COMM_NULL) {
9280     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9281     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9282     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9283     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9284     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9285   }
9286   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9287   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9288   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9289 
9290   if (ccomm != MPI_COMM_NULL) {
9291     Mat_MPIAIJ *a,*b;
9292     IS         from,to;
9293     Vec        gvec;
9294     PetscInt   lsize;
9295 
9296     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9297     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9298     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9299     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9300     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9301     a    = (Mat_MPIAIJ*)At->data;
9302     b    = (Mat_MPIAIJ*)(*B)->data;
9303     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9304     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9305     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9306     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9307     b->A = a->A;
9308     b->B = a->B;
9309 
9310     b->donotstash      = a->donotstash;
9311     b->roworiented     = a->roworiented;
9312     b->rowindices      = 0;
9313     b->rowvalues       = 0;
9314     b->getrowactive    = PETSC_FALSE;
9315 
9316     (*B)->rmap         = rmap;
9317     (*B)->factortype   = A->factortype;
9318     (*B)->assembled    = PETSC_TRUE;
9319     (*B)->insertmode   = NOT_SET_VALUES;
9320     (*B)->preallocated = PETSC_TRUE;
9321 
9322     if (a->colmap) {
9323 #if defined(PETSC_USE_CTABLE)
9324       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9325 #else
9326       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9327       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9328       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9329 #endif
9330     } else b->colmap = 0;
9331     if (a->garray) {
9332       PetscInt len;
9333       len  = a->B->cmap->n;
9334       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9335       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9336       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9337     } else b->garray = 0;
9338 
9339     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9340     b->lvec = a->lvec;
9341     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9342 
9343     /* cannot use VecScatterCopy */
9344     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9345     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9346     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9347     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9348     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9349     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9350     ierr = ISDestroy(&from);CHKERRQ(ierr);
9351     ierr = ISDestroy(&to);CHKERRQ(ierr);
9352     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9353   }
9354   ierr = MatDestroy(&At);CHKERRQ(ierr);
9355   PetscFunctionReturn(0);
9356 }
9357