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