xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision c1e67a491dcd3fce18efcb05d6f137bc2aa8e6a9)
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;
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 = PetscMalloc1(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     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1491   }
1492 
1493   /* compute local quad vec */
1494   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1495   if (!transpose) {
1496     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1497   } else {
1498     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1499   }
1500   ierr = VecSet(p,1.);CHKERRQ(ierr);
1501   if (!transpose) {
1502     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1503   } else {
1504     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1505   }
1506   if (vl2l) {
1507     Mat        lA;
1508     VecScatter sc;
1509 
1510     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1511     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1512     ierr = VecScatterCreateWithData(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1513     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1516   } else {
1517     vins = v;
1518   }
1519   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1520   ierr = VecDestroy(&p);CHKERRQ(ierr);
1521 
1522   /* insert in global quadrature vecs */
1523   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1524   for (i=0;i<n_neigh;i++) {
1525     const PetscInt    *idxs;
1526     PetscInt          idx,nn,j;
1527 
1528     idxs = shared[i];
1529     nn   = n_shared[i];
1530     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1531     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1532     idx  = -(idx+1);
1533     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,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 = PetscFree(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_set);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->A_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       /* Allow user's customization */
5305       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5306       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5307       if (f && pcbddc->mat_graph->cloc) {
5308         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5309         const PetscInt *idxs;
5310         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5311 
5312         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5313         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5314         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5315         for (i=0;i<nl;i++) {
5316           for (d=0;d<cdim;d++) {
5317             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5318           }
5319         }
5320         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5321         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5322         ierr = PetscFree(scoords);CHKERRQ(ierr);
5323       }
5324     }
5325     ierr = MatSetOptionsPrefix(pcis->A_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5326     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5327     if (sub_schurs && sub_schurs->reuse_solver) {
5328       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5329 
5330       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5331     }
5332     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5333     if (!n_D) {
5334       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5335       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5336     }
5337     /* set ksp_D into pcis data */
5338     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5339     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5340     pcis->ksp_D = pcbddc->ksp_D;
5341   }
5342 
5343   /* NEUMANN PROBLEM */
5344   A_RR = 0;
5345   if (neumann) {
5346     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5347     PetscInt        ibs,mbs;
5348     PetscBool       issbaij, reuse_neumann_solver;
5349     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5350 
5351     reuse_neumann_solver = PETSC_FALSE;
5352     if (sub_schurs && sub_schurs->reuse_solver) {
5353       IS iP;
5354 
5355       reuse_neumann_solver = PETSC_TRUE;
5356       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5357       if (iP) reuse_neumann_solver = PETSC_FALSE;
5358     }
5359     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5360     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5361     if (pcbddc->ksp_R) { /* already created ksp */
5362       PetscInt nn_R;
5363       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5364       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5365       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5366       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5367         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5368         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5369         reuse = MAT_INITIAL_MATRIX;
5370       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5371         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5372           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5373           reuse = MAT_INITIAL_MATRIX;
5374         } else { /* safe to reuse the matrix */
5375           reuse = MAT_REUSE_MATRIX;
5376         }
5377       }
5378       /* last check */
5379       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5380         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5381         reuse = MAT_INITIAL_MATRIX;
5382       }
5383     } else { /* first time, so we need to create the matrix */
5384       reuse = MAT_INITIAL_MATRIX;
5385     }
5386     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5387     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5388     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5389     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5390     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5391       if (matis->A == pcbddc->local_mat) {
5392         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5393         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5394       } else {
5395         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5396       }
5397     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5398       if (matis->A == pcbddc->local_mat) {
5399         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5400         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5401       } else {
5402         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5403       }
5404     }
5405     /* extract A_RR */
5406     if (reuse_neumann_solver) {
5407       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5408 
5409       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5410         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5411         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5412           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5413         } else {
5414           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5415         }
5416       } else {
5417         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5418         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5419         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5420       }
5421     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5422       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5423     }
5424     if (pcbddc->local_mat->symmetric_set) {
5425       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5426     }
5427     if (!pcbddc->ksp_R) { /* create object if not present */
5428       void (*f)(void) = 0;
5429 
5430       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5431       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5432       /* default */
5433       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5434       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5435       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5436       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5437       if (issbaij) {
5438         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5439       } else {
5440         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5441       }
5442       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5443       /* Allow user's customization */
5444       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5445       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5446       if (f && pcbddc->mat_graph->cloc) {
5447         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5448         const PetscInt *idxs;
5449         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5450 
5451         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5452         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5453         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5454         for (i=0;i<nl;i++) {
5455           for (d=0;d<cdim;d++) {
5456             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5457           }
5458         }
5459         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5460         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5461         ierr = PetscFree(scoords);CHKERRQ(ierr);
5462       }
5463     }
5464     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5465     if (!n_R) {
5466       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5467       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5468     }
5469     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5470     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5471     /* Reuse solver if it is present */
5472     if (reuse_neumann_solver) {
5473       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5474 
5475       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5476     }
5477   }
5478 
5479   if (pcbddc->dbg_flag) {
5480     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5481     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5482     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5483   }
5484 
5485   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5486   check_corr = PETSC_FALSE;
5487   if (pcbddc->NullSpace_corr[0]) {
5488     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5489   }
5490   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5491     check_corr = PETSC_TRUE;
5492     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5493   }
5494   if (neumann && pcbddc->NullSpace_corr[2]) {
5495     check_corr = PETSC_TRUE;
5496     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5497   }
5498   /* check Dirichlet and Neumann solvers */
5499   if (pcbddc->dbg_flag) {
5500     if (dirichlet) { /* Dirichlet */
5501       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5502       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5503       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5504       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5505       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5506       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5507       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);
5508       if (check_corr) {
5509         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5510       }
5511       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5512     }
5513     if (neumann) { /* Neumann */
5514       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5515       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5516       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5517       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5518       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5519       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5520       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);
5521       if (check_corr) {
5522         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5523       }
5524       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5525     }
5526   }
5527   /* free Neumann problem's matrix */
5528   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5529   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5530   PetscFunctionReturn(0);
5531 }
5532 
5533 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5534 {
5535   PetscErrorCode  ierr;
5536   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5537   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5538   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5539 
5540   PetscFunctionBegin;
5541   if (!reuse_solver) {
5542     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5543   }
5544   if (!pcbddc->switch_static) {
5545     if (applytranspose && pcbddc->local_auxmat1) {
5546       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5547       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5548     }
5549     if (!reuse_solver) {
5550       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5551       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5552     } else {
5553       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5554 
5555       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5556       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5557     }
5558   } else {
5559     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5560     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5561     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5562     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5563     if (applytranspose && pcbddc->local_auxmat1) {
5564       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5565       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5566       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5567       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5568     }
5569   }
5570   if (!reuse_solver || pcbddc->switch_static) {
5571     if (applytranspose) {
5572       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5573     } else {
5574       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5575     }
5576     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5577   } else {
5578     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5579 
5580     if (applytranspose) {
5581       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5582     } else {
5583       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5584     }
5585   }
5586   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5587   if (!pcbddc->switch_static) {
5588     if (!reuse_solver) {
5589       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5590       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5591     } else {
5592       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5593 
5594       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5595       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5596     }
5597     if (!applytranspose && pcbddc->local_auxmat1) {
5598       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5599       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5600     }
5601   } else {
5602     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5603     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5604     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5605     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5606     if (!applytranspose && pcbddc->local_auxmat1) {
5607       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5608       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5609     }
5610     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5611     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5612     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5613     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5614   }
5615   PetscFunctionReturn(0);
5616 }
5617 
5618 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5619 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5620 {
5621   PetscErrorCode ierr;
5622   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5623   PC_IS*            pcis = (PC_IS*)  (pc->data);
5624   const PetscScalar zero = 0.0;
5625 
5626   PetscFunctionBegin;
5627   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5628   if (!pcbddc->benign_apply_coarse_only) {
5629     if (applytranspose) {
5630       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5631       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5632     } else {
5633       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5634       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5635     }
5636   } else {
5637     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5638   }
5639 
5640   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5641   if (pcbddc->benign_n) {
5642     PetscScalar *array;
5643     PetscInt    j;
5644 
5645     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5646     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5647     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5648   }
5649 
5650   /* start communications from local primal nodes to rhs of coarse solver */
5651   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5652   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5653   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5654 
5655   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5656   if (pcbddc->coarse_ksp) {
5657     Mat          coarse_mat;
5658     Vec          rhs,sol;
5659     MatNullSpace nullsp;
5660     PetscBool    isbddc = PETSC_FALSE;
5661 
5662     if (pcbddc->benign_have_null) {
5663       PC        coarse_pc;
5664 
5665       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5666       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5667       /* we need to propagate to coarser levels the need for a possible benign correction */
5668       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5669         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5670         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5671         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5672       }
5673     }
5674     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5675     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5676     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5677     if (applytranspose) {
5678       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5679       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5680       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5681       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5682       if (nullsp) {
5683         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5684       }
5685     } else {
5686       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5687       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5688         PC        coarse_pc;
5689 
5690         if (nullsp) {
5691           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5692         }
5693         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5694         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5695         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5696         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5697       } else {
5698         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5699         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5700         if (nullsp) {
5701           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5702         }
5703       }
5704     }
5705     /* we don't need the benign correction at coarser levels anymore */
5706     if (pcbddc->benign_have_null && isbddc) {
5707       PC        coarse_pc;
5708       PC_BDDC*  coarsepcbddc;
5709 
5710       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5711       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5712       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5713       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5714     }
5715   }
5716 
5717   /* Local solution on R nodes */
5718   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5719     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5720   }
5721   /* communications from coarse sol to local primal nodes */
5722   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5723   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5724 
5725   /* Sum contributions from the two levels */
5726   if (!pcbddc->benign_apply_coarse_only) {
5727     if (applytranspose) {
5728       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5729       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5730     } else {
5731       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5732       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5733     }
5734     /* store p0 */
5735     if (pcbddc->benign_n) {
5736       PetscScalar *array;
5737       PetscInt    j;
5738 
5739       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5740       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5741       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5742     }
5743   } else { /* expand the coarse solution */
5744     if (applytranspose) {
5745       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5746     } else {
5747       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5748     }
5749   }
5750   PetscFunctionReturn(0);
5751 }
5752 
5753 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5754 {
5755   PetscErrorCode ierr;
5756   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5757   PetscScalar    *array;
5758   Vec            from,to;
5759 
5760   PetscFunctionBegin;
5761   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5762     from = pcbddc->coarse_vec;
5763     to = pcbddc->vec1_P;
5764     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5765       Vec tvec;
5766 
5767       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5768       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5769       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5770       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5771       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5772       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5773     }
5774   } else { /* from local to global -> put data in coarse right hand side */
5775     from = pcbddc->vec1_P;
5776     to = pcbddc->coarse_vec;
5777   }
5778   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5779   PetscFunctionReturn(0);
5780 }
5781 
5782 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5783 {
5784   PetscErrorCode ierr;
5785   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5786   PetscScalar    *array;
5787   Vec            from,to;
5788 
5789   PetscFunctionBegin;
5790   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5791     from = pcbddc->coarse_vec;
5792     to = pcbddc->vec1_P;
5793   } else { /* from local to global -> put data in coarse right hand side */
5794     from = pcbddc->vec1_P;
5795     to = pcbddc->coarse_vec;
5796   }
5797   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5798   if (smode == SCATTER_FORWARD) {
5799     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5800       Vec tvec;
5801 
5802       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5803       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5804       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5805       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5806     }
5807   } else {
5808     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5809      ierr = VecResetArray(from);CHKERRQ(ierr);
5810     }
5811   }
5812   PetscFunctionReturn(0);
5813 }
5814 
5815 /* uncomment for testing purposes */
5816 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5817 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5818 {
5819   PetscErrorCode    ierr;
5820   PC_IS*            pcis = (PC_IS*)(pc->data);
5821   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5822   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5823   /* one and zero */
5824   PetscScalar       one=1.0,zero=0.0;
5825   /* space to store constraints and their local indices */
5826   PetscScalar       *constraints_data;
5827   PetscInt          *constraints_idxs,*constraints_idxs_B;
5828   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5829   PetscInt          *constraints_n;
5830   /* iterators */
5831   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5832   /* BLAS integers */
5833   PetscBLASInt      lwork,lierr;
5834   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5835   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5836   /* reuse */
5837   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5838   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5839   /* change of basis */
5840   PetscBool         qr_needed;
5841   PetscBT           change_basis,qr_needed_idx;
5842   /* auxiliary stuff */
5843   PetscInt          *nnz,*is_indices;
5844   PetscInt          ncc;
5845   /* some quantities */
5846   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5847   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5848   PetscReal         tol; /* tolerance for retaining eigenmodes */
5849 
5850   PetscFunctionBegin;
5851   tol  = PetscSqrtReal(PETSC_SMALL);
5852   /* Destroy Mat objects computed previously */
5853   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5854   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5855   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5856   /* save info on constraints from previous setup (if any) */
5857   olocal_primal_size = pcbddc->local_primal_size;
5858   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5859   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5860   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5861   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5862   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5863   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5864 
5865   if (!pcbddc->adaptive_selection) {
5866     IS           ISForVertices,*ISForFaces,*ISForEdges;
5867     MatNullSpace nearnullsp;
5868     const Vec    *nearnullvecs;
5869     Vec          *localnearnullsp;
5870     PetscScalar  *array;
5871     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5872     PetscBool    nnsp_has_cnst;
5873     /* LAPACK working arrays for SVD or POD */
5874     PetscBool    skip_lapack,boolforchange;
5875     PetscScalar  *work;
5876     PetscReal    *singular_vals;
5877 #if defined(PETSC_USE_COMPLEX)
5878     PetscReal    *rwork;
5879 #endif
5880 #if defined(PETSC_MISSING_LAPACK_GESVD)
5881     PetscScalar  *temp_basis,*correlation_mat;
5882 #else
5883     PetscBLASInt dummy_int=1;
5884     PetscScalar  dummy_scalar=1.;
5885 #endif
5886 
5887     /* Get index sets for faces, edges and vertices from graph */
5888     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5889     /* print some info */
5890     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5891       PetscInt nv;
5892 
5893       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5894       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5895       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5896       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5897       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5898       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5899       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5900       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5901       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5902     }
5903 
5904     /* free unneeded index sets */
5905     if (!pcbddc->use_vertices) {
5906       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5907     }
5908     if (!pcbddc->use_edges) {
5909       for (i=0;i<n_ISForEdges;i++) {
5910         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5911       }
5912       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5913       n_ISForEdges = 0;
5914     }
5915     if (!pcbddc->use_faces) {
5916       for (i=0;i<n_ISForFaces;i++) {
5917         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5918       }
5919       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5920       n_ISForFaces = 0;
5921     }
5922 
5923     /* check if near null space is attached to global mat */
5924     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5925     if (nearnullsp) {
5926       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5927       /* remove any stored info */
5928       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5929       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5930       /* store information for BDDC solver reuse */
5931       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5932       pcbddc->onearnullspace = nearnullsp;
5933       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5934       for (i=0;i<nnsp_size;i++) {
5935         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5936       }
5937     } else { /* if near null space is not provided BDDC uses constants by default */
5938       nnsp_size = 0;
5939       nnsp_has_cnst = PETSC_TRUE;
5940     }
5941     /* get max number of constraints on a single cc */
5942     max_constraints = nnsp_size;
5943     if (nnsp_has_cnst) max_constraints++;
5944 
5945     /*
5946          Evaluate maximum storage size needed by the procedure
5947          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5948          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5949          There can be multiple constraints per connected component
5950                                                                                                                                                            */
5951     n_vertices = 0;
5952     if (ISForVertices) {
5953       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5954     }
5955     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5956     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5957 
5958     total_counts = n_ISForFaces+n_ISForEdges;
5959     total_counts *= max_constraints;
5960     total_counts += n_vertices;
5961     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5962 
5963     total_counts = 0;
5964     max_size_of_constraint = 0;
5965     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5966       IS used_is;
5967       if (i<n_ISForEdges) {
5968         used_is = ISForEdges[i];
5969       } else {
5970         used_is = ISForFaces[i-n_ISForEdges];
5971       }
5972       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5973       total_counts += j;
5974       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5975     }
5976     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);
5977 
5978     /* get local part of global near null space vectors */
5979     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5980     for (k=0;k<nnsp_size;k++) {
5981       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5982       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5983       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5984     }
5985 
5986     /* whether or not to skip lapack calls */
5987     skip_lapack = PETSC_TRUE;
5988     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5989 
5990     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5991     if (!skip_lapack) {
5992       PetscScalar temp_work;
5993 
5994 #if defined(PETSC_MISSING_LAPACK_GESVD)
5995       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5996       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5997       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5998       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5999 #if defined(PETSC_USE_COMPLEX)
6000       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6001 #endif
6002       /* now we evaluate the optimal workspace using query with lwork=-1 */
6003       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6004       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6005       lwork = -1;
6006       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6007 #if !defined(PETSC_USE_COMPLEX)
6008       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6009 #else
6010       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6011 #endif
6012       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6013       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6014 #else /* on missing GESVD */
6015       /* SVD */
6016       PetscInt max_n,min_n;
6017       max_n = max_size_of_constraint;
6018       min_n = max_constraints;
6019       if (max_size_of_constraint < max_constraints) {
6020         min_n = max_size_of_constraint;
6021         max_n = max_constraints;
6022       }
6023       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6024 #if defined(PETSC_USE_COMPLEX)
6025       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6026 #endif
6027       /* now we evaluate the optimal workspace using query with lwork=-1 */
6028       lwork = -1;
6029       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6030       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6031       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6032       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6033 #if !defined(PETSC_USE_COMPLEX)
6034       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));
6035 #else
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,rwork,&lierr));
6037 #endif
6038       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6039       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6040 #endif /* on missing GESVD */
6041       /* Allocate optimal workspace */
6042       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6043       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6044     }
6045     /* Now we can loop on constraining sets */
6046     total_counts = 0;
6047     constraints_idxs_ptr[0] = 0;
6048     constraints_data_ptr[0] = 0;
6049     /* vertices */
6050     if (n_vertices) {
6051       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6052       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6053       for (i=0;i<n_vertices;i++) {
6054         constraints_n[total_counts] = 1;
6055         constraints_data[total_counts] = 1.0;
6056         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6057         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6058         total_counts++;
6059       }
6060       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6061       n_vertices = total_counts;
6062     }
6063 
6064     /* edges and faces */
6065     total_counts_cc = total_counts;
6066     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6067       IS        used_is;
6068       PetscBool idxs_copied = PETSC_FALSE;
6069 
6070       if (ncc<n_ISForEdges) {
6071         used_is = ISForEdges[ncc];
6072         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6073       } else {
6074         used_is = ISForFaces[ncc-n_ISForEdges];
6075         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6076       }
6077       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6078 
6079       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6080       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6081       /* change of basis should not be performed on local periodic nodes */
6082       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6083       if (nnsp_has_cnst) {
6084         PetscScalar quad_value;
6085 
6086         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6087         idxs_copied = PETSC_TRUE;
6088 
6089         if (!pcbddc->use_nnsp_true) {
6090           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6091         } else {
6092           quad_value = 1.0;
6093         }
6094         for (j=0;j<size_of_constraint;j++) {
6095           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6096         }
6097         temp_constraints++;
6098         total_counts++;
6099       }
6100       for (k=0;k<nnsp_size;k++) {
6101         PetscReal real_value;
6102         PetscScalar *ptr_to_data;
6103 
6104         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6105         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6106         for (j=0;j<size_of_constraint;j++) {
6107           ptr_to_data[j] = array[is_indices[j]];
6108         }
6109         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6110         /* check if array is null on the connected component */
6111         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6112         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6113         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6114           temp_constraints++;
6115           total_counts++;
6116           if (!idxs_copied) {
6117             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6118             idxs_copied = PETSC_TRUE;
6119           }
6120         }
6121       }
6122       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6123       valid_constraints = temp_constraints;
6124       if (!pcbddc->use_nnsp_true && temp_constraints) {
6125         if (temp_constraints == 1) { /* just normalize the constraint */
6126           PetscScalar norm,*ptr_to_data;
6127 
6128           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6129           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6130           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6131           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6132           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6133         } else { /* perform SVD */
6134           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6135 
6136 #if defined(PETSC_MISSING_LAPACK_GESVD)
6137           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6138              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6139              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6140                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6141                 from that computed using LAPACKgesvd
6142              -> This is due to a different computation of eigenvectors in LAPACKheev
6143              -> The quality of the POD-computed basis will be the same */
6144           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6145           /* Store upper triangular part of correlation matrix */
6146           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6147           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6148           for (j=0;j<temp_constraints;j++) {
6149             for (k=0;k<j+1;k++) {
6150               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));
6151             }
6152           }
6153           /* compute eigenvalues and eigenvectors of correlation matrix */
6154           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6155           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6156 #if !defined(PETSC_USE_COMPLEX)
6157           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6158 #else
6159           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6160 #endif
6161           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6162           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6163           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6164           j = 0;
6165           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6166           total_counts = total_counts-j;
6167           valid_constraints = temp_constraints-j;
6168           /* scale and copy POD basis into used quadrature memory */
6169           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6170           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6171           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6172           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6173           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6174           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6175           if (j<temp_constraints) {
6176             PetscInt ii;
6177             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6178             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6179             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));
6180             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6181             for (k=0;k<temp_constraints-j;k++) {
6182               for (ii=0;ii<size_of_constraint;ii++) {
6183                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6184               }
6185             }
6186           }
6187 #else  /* on missing GESVD */
6188           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6189           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6190           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6191           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6192 #if !defined(PETSC_USE_COMPLEX)
6193           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));
6194 #else
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,rwork,&lierr));
6196 #endif
6197           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6198           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6199           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6200           k = temp_constraints;
6201           if (k > size_of_constraint) k = size_of_constraint;
6202           j = 0;
6203           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6204           valid_constraints = k-j;
6205           total_counts = total_counts-temp_constraints+valid_constraints;
6206 #endif /* on missing GESVD */
6207         }
6208       }
6209       /* update pointers information */
6210       if (valid_constraints) {
6211         constraints_n[total_counts_cc] = valid_constraints;
6212         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6213         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6214         /* set change_of_basis flag */
6215         if (boolforchange) {
6216           PetscBTSet(change_basis,total_counts_cc);
6217         }
6218         total_counts_cc++;
6219       }
6220     }
6221     /* free workspace */
6222     if (!skip_lapack) {
6223       ierr = PetscFree(work);CHKERRQ(ierr);
6224 #if defined(PETSC_USE_COMPLEX)
6225       ierr = PetscFree(rwork);CHKERRQ(ierr);
6226 #endif
6227       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6228 #if defined(PETSC_MISSING_LAPACK_GESVD)
6229       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6230       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6231 #endif
6232     }
6233     for (k=0;k<nnsp_size;k++) {
6234       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6235     }
6236     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6237     /* free index sets of faces, edges and vertices */
6238     for (i=0;i<n_ISForFaces;i++) {
6239       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6240     }
6241     if (n_ISForFaces) {
6242       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6243     }
6244     for (i=0;i<n_ISForEdges;i++) {
6245       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6246     }
6247     if (n_ISForEdges) {
6248       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6249     }
6250     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6251   } else {
6252     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6253 
6254     total_counts = 0;
6255     n_vertices = 0;
6256     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6257       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6258     }
6259     max_constraints = 0;
6260     total_counts_cc = 0;
6261     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6262       total_counts += pcbddc->adaptive_constraints_n[i];
6263       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6264       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6265     }
6266     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6267     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6268     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6269     constraints_data = pcbddc->adaptive_constraints_data;
6270     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6271     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6272     total_counts_cc = 0;
6273     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6274       if (pcbddc->adaptive_constraints_n[i]) {
6275         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6276       }
6277     }
6278 
6279     max_size_of_constraint = 0;
6280     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]);
6281     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6282     /* Change of basis */
6283     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6284     if (pcbddc->use_change_of_basis) {
6285       for (i=0;i<sub_schurs->n_subs;i++) {
6286         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6287           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6288         }
6289       }
6290     }
6291   }
6292   pcbddc->local_primal_size = total_counts;
6293   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6294 
6295   /* map constraints_idxs in boundary numbering */
6296   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6297   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);
6298 
6299   /* Create constraint matrix */
6300   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6301   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6302   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6303 
6304   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6305   /* determine if a QR strategy is needed for change of basis */
6306   qr_needed = pcbddc->use_qr_single;
6307   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6308   total_primal_vertices=0;
6309   pcbddc->local_primal_size_cc = 0;
6310   for (i=0;i<total_counts_cc;i++) {
6311     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6312     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6313       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6314       pcbddc->local_primal_size_cc += 1;
6315     } else if (PetscBTLookup(change_basis,i)) {
6316       for (k=0;k<constraints_n[i];k++) {
6317         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6318       }
6319       pcbddc->local_primal_size_cc += constraints_n[i];
6320       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6321         PetscBTSet(qr_needed_idx,i);
6322         qr_needed = PETSC_TRUE;
6323       }
6324     } else {
6325       pcbddc->local_primal_size_cc += 1;
6326     }
6327   }
6328   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6329   pcbddc->n_vertices = total_primal_vertices;
6330   /* permute indices in order to have a sorted set of vertices */
6331   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6332   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);
6333   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6334   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6335 
6336   /* nonzero structure of constraint matrix */
6337   /* and get reference dof for local constraints */
6338   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6339   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6340 
6341   j = total_primal_vertices;
6342   total_counts = total_primal_vertices;
6343   cum = total_primal_vertices;
6344   for (i=n_vertices;i<total_counts_cc;i++) {
6345     if (!PetscBTLookup(change_basis,i)) {
6346       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6347       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6348       cum++;
6349       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6350       for (k=0;k<constraints_n[i];k++) {
6351         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6352         nnz[j+k] = size_of_constraint;
6353       }
6354       j += constraints_n[i];
6355     }
6356   }
6357   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6358   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6359   ierr = PetscFree(nnz);CHKERRQ(ierr);
6360 
6361   /* set values in constraint matrix */
6362   for (i=0;i<total_primal_vertices;i++) {
6363     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6364   }
6365   total_counts = total_primal_vertices;
6366   for (i=n_vertices;i<total_counts_cc;i++) {
6367     if (!PetscBTLookup(change_basis,i)) {
6368       PetscInt *cols;
6369 
6370       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6371       cols = constraints_idxs+constraints_idxs_ptr[i];
6372       for (k=0;k<constraints_n[i];k++) {
6373         PetscInt    row = total_counts+k;
6374         PetscScalar *vals;
6375 
6376         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6377         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6378       }
6379       total_counts += constraints_n[i];
6380     }
6381   }
6382   /* assembling */
6383   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6384   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6385   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6386 
6387   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6388   if (pcbddc->use_change_of_basis) {
6389     /* dual and primal dofs on a single cc */
6390     PetscInt     dual_dofs,primal_dofs;
6391     /* working stuff for GEQRF */
6392     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6393     PetscBLASInt lqr_work;
6394     /* working stuff for UNGQR */
6395     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6396     PetscBLASInt lgqr_work;
6397     /* working stuff for TRTRS */
6398     PetscScalar  *trs_rhs = NULL;
6399     PetscBLASInt Blas_NRHS;
6400     /* pointers for values insertion into change of basis matrix */
6401     PetscInt     *start_rows,*start_cols;
6402     PetscScalar  *start_vals;
6403     /* working stuff for values insertion */
6404     PetscBT      is_primal;
6405     PetscInt     *aux_primal_numbering_B;
6406     /* matrix sizes */
6407     PetscInt     global_size,local_size;
6408     /* temporary change of basis */
6409     Mat          localChangeOfBasisMatrix;
6410     /* extra space for debugging */
6411     PetscScalar  *dbg_work = NULL;
6412 
6413     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6414     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6415     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6416     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6417     /* nonzeros for local mat */
6418     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6419     if (!pcbddc->benign_change || pcbddc->fake_change) {
6420       for (i=0;i<pcis->n;i++) nnz[i]=1;
6421     } else {
6422       const PetscInt *ii;
6423       PetscInt       n;
6424       PetscBool      flg_row;
6425       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6426       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6427       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6428     }
6429     for (i=n_vertices;i<total_counts_cc;i++) {
6430       if (PetscBTLookup(change_basis,i)) {
6431         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6432         if (PetscBTLookup(qr_needed_idx,i)) {
6433           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6434         } else {
6435           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6436           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6437         }
6438       }
6439     }
6440     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6441     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6442     ierr = PetscFree(nnz);CHKERRQ(ierr);
6443     /* Set interior change in the matrix */
6444     if (!pcbddc->benign_change || pcbddc->fake_change) {
6445       for (i=0;i<pcis->n;i++) {
6446         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6447       }
6448     } else {
6449       const PetscInt *ii,*jj;
6450       PetscScalar    *aa;
6451       PetscInt       n;
6452       PetscBool      flg_row;
6453       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6454       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6455       for (i=0;i<n;i++) {
6456         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6457       }
6458       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6459       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6460     }
6461 
6462     if (pcbddc->dbg_flag) {
6463       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6464       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6465     }
6466 
6467 
6468     /* Now we loop on the constraints which need a change of basis */
6469     /*
6470        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6471        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6472 
6473        Basic blocks of change of basis matrix T computed by
6474 
6475           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6476 
6477             | 1        0   ...        0         s_1/S |
6478             | 0        1   ...        0         s_2/S |
6479             |              ...                        |
6480             | 0        ...            1     s_{n-1}/S |
6481             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6482 
6483             with S = \sum_{i=1}^n s_i^2
6484             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6485                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6486 
6487           - QR decomposition of constraints otherwise
6488     */
6489     if (qr_needed && max_size_of_constraint) {
6490       /* space to store Q */
6491       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6492       /* array to store scaling factors for reflectors */
6493       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6494       /* first we issue queries for optimal work */
6495       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6496       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6497       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6498       lqr_work = -1;
6499       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6500       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6501       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6502       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6503       lgqr_work = -1;
6504       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6505       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6506       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6507       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6508       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6509       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6510       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6511       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6512       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6513       /* array to store rhs and solution of triangular solver */
6514       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6515       /* allocating workspace for check */
6516       if (pcbddc->dbg_flag) {
6517         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6518       }
6519     }
6520     /* array to store whether a node is primal or not */
6521     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6522     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6523     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6524     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);
6525     for (i=0;i<total_primal_vertices;i++) {
6526       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6527     }
6528     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6529 
6530     /* loop on constraints and see whether or not they need a change of basis and compute it */
6531     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6532       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6533       if (PetscBTLookup(change_basis,total_counts)) {
6534         /* get constraint info */
6535         primal_dofs = constraints_n[total_counts];
6536         dual_dofs = size_of_constraint-primal_dofs;
6537 
6538         if (pcbddc->dbg_flag) {
6539           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);
6540         }
6541 
6542         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6543 
6544           /* copy quadrature constraints for change of basis check */
6545           if (pcbddc->dbg_flag) {
6546             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6547           }
6548           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6549           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6550 
6551           /* compute QR decomposition of constraints */
6552           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6553           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6554           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6555           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6556           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6557           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6558           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6559 
6560           /* explictly compute R^-T */
6561           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6562           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6563           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6564           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6565           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6566           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6567           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6568           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6569           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6570           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6571 
6572           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6573           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6574           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6575           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6576           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6577           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6578           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6579           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6580           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6581 
6582           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6583              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6584              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6585           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6586           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6587           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6588           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6589           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6590           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6591           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6592           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));
6593           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6594           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6595 
6596           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6597           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6598           /* insert cols for primal dofs */
6599           for (j=0;j<primal_dofs;j++) {
6600             start_vals = &qr_basis[j*size_of_constraint];
6601             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6602             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6603           }
6604           /* insert cols for dual dofs */
6605           for (j=0,k=0;j<dual_dofs;k++) {
6606             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6607               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6608               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6609               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6610               j++;
6611             }
6612           }
6613 
6614           /* check change of basis */
6615           if (pcbddc->dbg_flag) {
6616             PetscInt   ii,jj;
6617             PetscBool valid_qr=PETSC_TRUE;
6618             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6619             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6620             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6621             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6622             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6623             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6624             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6625             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));
6626             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6627             for (jj=0;jj<size_of_constraint;jj++) {
6628               for (ii=0;ii<primal_dofs;ii++) {
6629                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6630                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6631               }
6632             }
6633             if (!valid_qr) {
6634               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6635               for (jj=0;jj<size_of_constraint;jj++) {
6636                 for (ii=0;ii<primal_dofs;ii++) {
6637                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6638                     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);
6639                   }
6640                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6641                     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);
6642                   }
6643                 }
6644               }
6645             } else {
6646               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6647             }
6648           }
6649         } else { /* simple transformation block */
6650           PetscInt    row,col;
6651           PetscScalar val,norm;
6652 
6653           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6654           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6655           for (j=0;j<size_of_constraint;j++) {
6656             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6657             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6658             if (!PetscBTLookup(is_primal,row_B)) {
6659               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6660               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6661               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6662             } else {
6663               for (k=0;k<size_of_constraint;k++) {
6664                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6665                 if (row != col) {
6666                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6667                 } else {
6668                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6669                 }
6670                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6671               }
6672             }
6673           }
6674           if (pcbddc->dbg_flag) {
6675             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6676           }
6677         }
6678       } else {
6679         if (pcbddc->dbg_flag) {
6680           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6681         }
6682       }
6683     }
6684 
6685     /* free workspace */
6686     if (qr_needed) {
6687       if (pcbddc->dbg_flag) {
6688         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6689       }
6690       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6691       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6692       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6693       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6694       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6695     }
6696     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6697     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6698     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6699 
6700     /* assembling of global change of variable */
6701     if (!pcbddc->fake_change) {
6702       Mat      tmat;
6703       PetscInt bs;
6704 
6705       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6706       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6707       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6708       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6709       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6710       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6711       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6712       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6713       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6714       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6715       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6716       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6717       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6718       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6719       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6720       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6721       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6722       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6723       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6724       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6725 
6726       /* check */
6727       if (pcbddc->dbg_flag) {
6728         PetscReal error;
6729         Vec       x,x_change;
6730 
6731         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6732         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6733         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6734         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6735         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6736         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6737         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6738         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6739         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6740         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6741         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6742         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6743         if (error > PETSC_SMALL) {
6744           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6745         }
6746         ierr = VecDestroy(&x);CHKERRQ(ierr);
6747         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6748       }
6749       /* adapt sub_schurs computed (if any) */
6750       if (pcbddc->use_deluxe_scaling) {
6751         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6752 
6753         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");
6754         if (sub_schurs && sub_schurs->S_Ej_all) {
6755           Mat                    S_new,tmat;
6756           IS                     is_all_N,is_V_Sall = NULL;
6757 
6758           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6759           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6760           if (pcbddc->deluxe_zerorows) {
6761             ISLocalToGlobalMapping NtoSall;
6762             IS                     is_V;
6763             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6764             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6765             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6766             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6767             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6768           }
6769           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6770           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6771           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6772           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6773           if (pcbddc->deluxe_zerorows) {
6774             const PetscScalar *array;
6775             const PetscInt    *idxs_V,*idxs_all;
6776             PetscInt          i,n_V;
6777 
6778             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6779             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6780             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6781             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6782             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6783             for (i=0;i<n_V;i++) {
6784               PetscScalar val;
6785               PetscInt    idx;
6786 
6787               idx = idxs_V[i];
6788               val = array[idxs_all[idxs_V[i]]];
6789               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6790             }
6791             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6792             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6793             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6794             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6795             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6796           }
6797           sub_schurs->S_Ej_all = S_new;
6798           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6799           if (sub_schurs->sum_S_Ej_all) {
6800             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6801             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6802             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6803             if (pcbddc->deluxe_zerorows) {
6804               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6805             }
6806             sub_schurs->sum_S_Ej_all = S_new;
6807             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6808           }
6809           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6810           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6811         }
6812         /* destroy any change of basis context in sub_schurs */
6813         if (sub_schurs && sub_schurs->change) {
6814           PetscInt i;
6815 
6816           for (i=0;i<sub_schurs->n_subs;i++) {
6817             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6818           }
6819           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6820         }
6821       }
6822       if (pcbddc->switch_static) { /* need to save the local change */
6823         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6824       } else {
6825         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6826       }
6827       /* determine if any process has changed the pressures locally */
6828       pcbddc->change_interior = pcbddc->benign_have_null;
6829     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6830       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6831       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6832       pcbddc->use_qr_single = qr_needed;
6833     }
6834   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6835     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6836       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6837       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6838     } else {
6839       Mat benign_global = NULL;
6840       if (pcbddc->benign_have_null) {
6841         Mat M;
6842 
6843         pcbddc->change_interior = PETSC_TRUE;
6844         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6845         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6846         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6847         if (pcbddc->benign_change) {
6848           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6849           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6850         } else {
6851           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6852           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6853         }
6854         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6855         ierr = MatDestroy(&M);CHKERRQ(ierr);
6856         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6857         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6858       }
6859       if (pcbddc->user_ChangeOfBasisMatrix) {
6860         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6861         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6862       } else if (pcbddc->benign_have_null) {
6863         pcbddc->ChangeOfBasisMatrix = benign_global;
6864       }
6865     }
6866     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6867       IS             is_global;
6868       const PetscInt *gidxs;
6869 
6870       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6871       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6872       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6873       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6874       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6875     }
6876   }
6877   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6878     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6879   }
6880 
6881   if (!pcbddc->fake_change) {
6882     /* add pressure dofs to set of primal nodes for numbering purposes */
6883     for (i=0;i<pcbddc->benign_n;i++) {
6884       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6885       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6886       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6887       pcbddc->local_primal_size_cc++;
6888       pcbddc->local_primal_size++;
6889     }
6890 
6891     /* check if a new primal space has been introduced (also take into account benign trick) */
6892     pcbddc->new_primal_space_local = PETSC_TRUE;
6893     if (olocal_primal_size == pcbddc->local_primal_size) {
6894       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6895       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6896       if (!pcbddc->new_primal_space_local) {
6897         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6898         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6899       }
6900     }
6901     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6902     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6903   }
6904   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6905 
6906   /* flush dbg viewer */
6907   if (pcbddc->dbg_flag) {
6908     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6909   }
6910 
6911   /* free workspace */
6912   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6913   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6914   if (!pcbddc->adaptive_selection) {
6915     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6916     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6917   } else {
6918     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6919                       pcbddc->adaptive_constraints_idxs_ptr,
6920                       pcbddc->adaptive_constraints_data_ptr,
6921                       pcbddc->adaptive_constraints_idxs,
6922                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6923     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6924     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6925   }
6926   PetscFunctionReturn(0);
6927 }
6928 /* #undef PETSC_MISSING_LAPACK_GESVD */
6929 
6930 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6931 {
6932   ISLocalToGlobalMapping map;
6933   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6934   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6935   PetscInt               i,N;
6936   PetscBool              rcsr = PETSC_FALSE;
6937   PetscErrorCode         ierr;
6938 
6939   PetscFunctionBegin;
6940   if (pcbddc->recompute_topography) {
6941     pcbddc->graphanalyzed = PETSC_FALSE;
6942     /* Reset previously computed graph */
6943     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6944     /* Init local Graph struct */
6945     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6946     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6947     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6948 
6949     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6950       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6951     }
6952     /* Check validity of the csr graph passed in by the user */
6953     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);
6954 
6955     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6956     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6957       PetscInt  *xadj,*adjncy;
6958       PetscInt  nvtxs;
6959       PetscBool flg_row=PETSC_FALSE;
6960 
6961       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6962       if (flg_row) {
6963         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6964         pcbddc->computed_rowadj = PETSC_TRUE;
6965       }
6966       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6967       rcsr = PETSC_TRUE;
6968     }
6969     if (pcbddc->dbg_flag) {
6970       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6971     }
6972 
6973     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6974       PetscReal    *lcoords;
6975       PetscInt     n;
6976       MPI_Datatype dimrealtype;
6977 
6978       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);
6979       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6980       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6981       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6982       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6983       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6984       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6985       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6986       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6987 
6988       pcbddc->mat_graph->coords = lcoords;
6989       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6990       pcbddc->mat_graph->cnloc  = n;
6991     }
6992     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);
6993     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6994 
6995     /* Setup of Graph */
6996     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6997     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6998 
6999     /* attach info on disconnected subdomains if present */
7000     if (pcbddc->n_local_subs) {
7001       PetscInt *local_subs;
7002 
7003       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
7004       for (i=0;i<pcbddc->n_local_subs;i++) {
7005         const PetscInt *idxs;
7006         PetscInt       nl,j;
7007 
7008         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7009         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7010         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7011         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7012       }
7013       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
7014       pcbddc->mat_graph->local_subs = local_subs;
7015     }
7016   }
7017 
7018   if (!pcbddc->graphanalyzed) {
7019     /* Graph's connected components analysis */
7020     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7021     pcbddc->graphanalyzed = PETSC_TRUE;
7022   }
7023   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7024   PetscFunctionReturn(0);
7025 }
7026 
7027 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7028 {
7029   PetscInt       i,j;
7030   PetscScalar    *alphas;
7031   PetscErrorCode ierr;
7032 
7033   PetscFunctionBegin;
7034   if (!n) PetscFunctionReturn(0);
7035   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7036   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
7037   for (i=1;i<n;i++) {
7038     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7039     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7040     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7041     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
7042   }
7043   ierr = PetscFree(alphas);CHKERRQ(ierr);
7044   PetscFunctionReturn(0);
7045 }
7046 
7047 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7048 {
7049   Mat            A;
7050   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7051   PetscMPIInt    size,rank,color;
7052   PetscInt       *xadj,*adjncy;
7053   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7054   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7055   PetscInt       void_procs,*procs_candidates = NULL;
7056   PetscInt       xadj_count,*count;
7057   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7058   PetscSubcomm   psubcomm;
7059   MPI_Comm       subcomm;
7060   PetscErrorCode ierr;
7061 
7062   PetscFunctionBegin;
7063   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7064   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7065   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);
7066   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7067   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7068   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7069 
7070   if (have_void) *have_void = PETSC_FALSE;
7071   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7072   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7073   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7074   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7075   im_active = !!n;
7076   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7077   void_procs = size - active_procs;
7078   /* get ranks of of non-active processes in mat communicator */
7079   if (void_procs) {
7080     PetscInt ncand;
7081 
7082     if (have_void) *have_void = PETSC_TRUE;
7083     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7084     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7085     for (i=0,ncand=0;i<size;i++) {
7086       if (!procs_candidates[i]) {
7087         procs_candidates[ncand++] = i;
7088       }
7089     }
7090     /* force n_subdomains to be not greater that the number of non-active processes */
7091     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7092   }
7093 
7094   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7095      number of subdomains requested 1 -> send to master or first candidate in voids  */
7096   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7097   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7098     PetscInt issize,isidx,dest;
7099     if (*n_subdomains == 1) dest = 0;
7100     else dest = rank;
7101     if (im_active) {
7102       issize = 1;
7103       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7104         isidx = procs_candidates[dest];
7105       } else {
7106         isidx = dest;
7107       }
7108     } else {
7109       issize = 0;
7110       isidx = -1;
7111     }
7112     if (*n_subdomains != 1) *n_subdomains = active_procs;
7113     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7114     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7115     PetscFunctionReturn(0);
7116   }
7117   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7118   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7119   threshold = PetscMax(threshold,2);
7120 
7121   /* Get info on mapping */
7122   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7123 
7124   /* build local CSR graph of subdomains' connectivity */
7125   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7126   xadj[0] = 0;
7127   xadj[1] = PetscMax(n_neighs-1,0);
7128   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7129   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7130   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7131   for (i=1;i<n_neighs;i++)
7132     for (j=0;j<n_shared[i];j++)
7133       count[shared[i][j]] += 1;
7134 
7135   xadj_count = 0;
7136   for (i=1;i<n_neighs;i++) {
7137     for (j=0;j<n_shared[i];j++) {
7138       if (count[shared[i][j]] < threshold) {
7139         adjncy[xadj_count] = neighs[i];
7140         adjncy_wgt[xadj_count] = n_shared[i];
7141         xadj_count++;
7142         break;
7143       }
7144     }
7145   }
7146   xadj[1] = xadj_count;
7147   ierr = PetscFree(count);CHKERRQ(ierr);
7148   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7149   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7150 
7151   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7152 
7153   /* Restrict work on active processes only */
7154   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7155   if (void_procs) {
7156     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7157     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7158     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7159     subcomm = PetscSubcommChild(psubcomm);
7160   } else {
7161     psubcomm = NULL;
7162     subcomm = PetscObjectComm((PetscObject)mat);
7163   }
7164 
7165   v_wgt = NULL;
7166   if (!color) {
7167     ierr = PetscFree(xadj);CHKERRQ(ierr);
7168     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7169     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7170   } else {
7171     Mat             subdomain_adj;
7172     IS              new_ranks,new_ranks_contig;
7173     MatPartitioning partitioner;
7174     PetscInt        rstart=0,rend=0;
7175     PetscInt        *is_indices,*oldranks;
7176     PetscMPIInt     size;
7177     PetscBool       aggregate;
7178 
7179     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7180     if (void_procs) {
7181       PetscInt prank = rank;
7182       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7183       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7184       for (i=0;i<xadj[1];i++) {
7185         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7186       }
7187       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7188     } else {
7189       oldranks = NULL;
7190     }
7191     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7192     if (aggregate) { /* TODO: all this part could be made more efficient */
7193       PetscInt    lrows,row,ncols,*cols;
7194       PetscMPIInt nrank;
7195       PetscScalar *vals;
7196 
7197       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7198       lrows = 0;
7199       if (nrank<redprocs) {
7200         lrows = size/redprocs;
7201         if (nrank<size%redprocs) lrows++;
7202       }
7203       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7204       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7205       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7206       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7207       row = nrank;
7208       ncols = xadj[1]-xadj[0];
7209       cols = adjncy;
7210       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7211       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7212       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7213       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7214       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7215       ierr = PetscFree(xadj);CHKERRQ(ierr);
7216       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7217       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7218       ierr = PetscFree(vals);CHKERRQ(ierr);
7219       if (use_vwgt) {
7220         Vec               v;
7221         const PetscScalar *array;
7222         PetscInt          nl;
7223 
7224         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7225         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7226         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7227         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7228         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7229         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7230         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7231         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7232         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7233         ierr = VecDestroy(&v);CHKERRQ(ierr);
7234       }
7235     } else {
7236       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7237       if (use_vwgt) {
7238         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7239         v_wgt[0] = n;
7240       }
7241     }
7242     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7243 
7244     /* Partition */
7245     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7246     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7247     if (v_wgt) {
7248       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7249     }
7250     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7251     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7252     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7253     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7254     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7255 
7256     /* renumber new_ranks to avoid "holes" in new set of processors */
7257     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7258     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7259     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7260     if (!aggregate) {
7261       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7262 #if defined(PETSC_USE_DEBUG)
7263         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7264 #endif
7265         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7266       } else if (oldranks) {
7267         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7268       } else {
7269         ranks_send_to_idx[0] = is_indices[0];
7270       }
7271     } else {
7272       PetscInt    idx = 0;
7273       PetscMPIInt tag;
7274       MPI_Request *reqs;
7275 
7276       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7277       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7278       for (i=rstart;i<rend;i++) {
7279         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7280       }
7281       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7282       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7283       ierr = PetscFree(reqs);CHKERRQ(ierr);
7284       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7285 #if defined(PETSC_USE_DEBUG)
7286         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7287 #endif
7288         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7289       } else if (oldranks) {
7290         ranks_send_to_idx[0] = oldranks[idx];
7291       } else {
7292         ranks_send_to_idx[0] = idx;
7293       }
7294     }
7295     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7296     /* clean up */
7297     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7298     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7299     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7300     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7301   }
7302   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7303   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7304 
7305   /* assemble parallel IS for sends */
7306   i = 1;
7307   if (!color) i=0;
7308   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7309   PetscFunctionReturn(0);
7310 }
7311 
7312 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7313 
7314 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[])
7315 {
7316   Mat                    local_mat;
7317   IS                     is_sends_internal;
7318   PetscInt               rows,cols,new_local_rows;
7319   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7320   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7321   ISLocalToGlobalMapping l2gmap;
7322   PetscInt*              l2gmap_indices;
7323   const PetscInt*        is_indices;
7324   MatType                new_local_type;
7325   /* buffers */
7326   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7327   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7328   PetscInt               *recv_buffer_idxs_local;
7329   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7330   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7331   /* MPI */
7332   MPI_Comm               comm,comm_n;
7333   PetscSubcomm           subcomm;
7334   PetscMPIInt            n_sends,n_recvs,size;
7335   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7336   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7337   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7338   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7339   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7340   PetscErrorCode         ierr;
7341 
7342   PetscFunctionBegin;
7343   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7344   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7345   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);
7346   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7347   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7348   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7349   PetscValidLogicalCollectiveBool(mat,reuse,6);
7350   PetscValidLogicalCollectiveInt(mat,nis,8);
7351   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7352   if (nvecs) {
7353     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7354     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7355   }
7356   /* further checks */
7357   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7358   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7359   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7360   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7361   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7362   if (reuse && *mat_n) {
7363     PetscInt mrows,mcols,mnrows,mncols;
7364     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7365     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7366     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7367     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7368     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7369     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7370     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7371   }
7372   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7373   PetscValidLogicalCollectiveInt(mat,bs,0);
7374 
7375   /* prepare IS for sending if not provided */
7376   if (!is_sends) {
7377     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7378     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7379   } else {
7380     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7381     is_sends_internal = is_sends;
7382   }
7383 
7384   /* get comm */
7385   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7386 
7387   /* compute number of sends */
7388   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7389   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7390 
7391   /* compute number of receives */
7392   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7393   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7394   ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
7395   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7396   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7397   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7398   ierr = PetscFree(iflags);CHKERRQ(ierr);
7399 
7400   /* restrict comm if requested */
7401   subcomm = 0;
7402   destroy_mat = PETSC_FALSE;
7403   if (restrict_comm) {
7404     PetscMPIInt color,subcommsize;
7405 
7406     color = 0;
7407     if (restrict_full) {
7408       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7409     } else {
7410       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7411     }
7412     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7413     subcommsize = size - subcommsize;
7414     /* check if reuse has been requested */
7415     if (reuse) {
7416       if (*mat_n) {
7417         PetscMPIInt subcommsize2;
7418         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7419         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7420         comm_n = PetscObjectComm((PetscObject)*mat_n);
7421       } else {
7422         comm_n = PETSC_COMM_SELF;
7423       }
7424     } else { /* MAT_INITIAL_MATRIX */
7425       PetscMPIInt rank;
7426 
7427       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7428       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7429       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7430       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7431       comm_n = PetscSubcommChild(subcomm);
7432     }
7433     /* flag to destroy *mat_n if not significative */
7434     if (color) destroy_mat = PETSC_TRUE;
7435   } else {
7436     comm_n = comm;
7437   }
7438 
7439   /* prepare send/receive buffers */
7440   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7441   ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7442   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7443   ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr);
7444   if (nis) {
7445     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7446   }
7447 
7448   /* Get data from local matrices */
7449   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7450     /* TODO: See below some guidelines on how to prepare the local buffers */
7451     /*
7452        send_buffer_vals should contain the raw values of the local matrix
7453        send_buffer_idxs should contain:
7454        - MatType_PRIVATE type
7455        - PetscInt        size_of_l2gmap
7456        - PetscInt        global_row_indices[size_of_l2gmap]
7457        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7458     */
7459   else {
7460     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7461     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7462     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7463     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7464     send_buffer_idxs[1] = i;
7465     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7466     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7467     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7468     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7469     for (i=0;i<n_sends;i++) {
7470       ilengths_vals[is_indices[i]] = len*len;
7471       ilengths_idxs[is_indices[i]] = len+2;
7472     }
7473   }
7474   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7475   /* additional is (if any) */
7476   if (nis) {
7477     PetscMPIInt psum;
7478     PetscInt j;
7479     for (j=0,psum=0;j<nis;j++) {
7480       PetscInt plen;
7481       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7482       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7483       psum += len+1; /* indices + lenght */
7484     }
7485     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7486     for (j=0,psum=0;j<nis;j++) {
7487       PetscInt plen;
7488       const PetscInt *is_array_idxs;
7489       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7490       send_buffer_idxs_is[psum] = plen;
7491       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7492       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7493       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7494       psum += plen+1; /* indices + lenght */
7495     }
7496     for (i=0;i<n_sends;i++) {
7497       ilengths_idxs_is[is_indices[i]] = psum;
7498     }
7499     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7500   }
7501   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7502 
7503   buf_size_idxs = 0;
7504   buf_size_vals = 0;
7505   buf_size_idxs_is = 0;
7506   buf_size_vecs = 0;
7507   for (i=0;i<n_recvs;i++) {
7508     buf_size_idxs += (PetscInt)olengths_idxs[i];
7509     buf_size_vals += (PetscInt)olengths_vals[i];
7510     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7511     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7512   }
7513   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7514   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7515   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7516   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7517 
7518   /* get new tags for clean communications */
7519   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7520   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7521   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7522   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7523 
7524   /* allocate for requests */
7525   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7526   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7527   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7528   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7529   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7530   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7531   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7532   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7533 
7534   /* communications */
7535   ptr_idxs = recv_buffer_idxs;
7536   ptr_vals = recv_buffer_vals;
7537   ptr_idxs_is = recv_buffer_idxs_is;
7538   ptr_vecs = recv_buffer_vecs;
7539   for (i=0;i<n_recvs;i++) {
7540     source_dest = onodes[i];
7541     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7542     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7543     ptr_idxs += olengths_idxs[i];
7544     ptr_vals += olengths_vals[i];
7545     if (nis) {
7546       source_dest = onodes_is[i];
7547       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);
7548       ptr_idxs_is += olengths_idxs_is[i];
7549     }
7550     if (nvecs) {
7551       source_dest = onodes[i];
7552       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7553       ptr_vecs += olengths_idxs[i]-2;
7554     }
7555   }
7556   for (i=0;i<n_sends;i++) {
7557     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7558     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7559     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7560     if (nis) {
7561       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);
7562     }
7563     if (nvecs) {
7564       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7565       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7566     }
7567   }
7568   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7569   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7570 
7571   /* assemble new l2g map */
7572   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7573   ptr_idxs = recv_buffer_idxs;
7574   new_local_rows = 0;
7575   for (i=0;i<n_recvs;i++) {
7576     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7577     ptr_idxs += olengths_idxs[i];
7578   }
7579   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7580   ptr_idxs = recv_buffer_idxs;
7581   new_local_rows = 0;
7582   for (i=0;i<n_recvs;i++) {
7583     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7584     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7585     ptr_idxs += olengths_idxs[i];
7586   }
7587   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7588   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7589   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7590 
7591   /* infer new local matrix type from received local matrices type */
7592   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7593   /* 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) */
7594   if (n_recvs) {
7595     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7596     ptr_idxs = recv_buffer_idxs;
7597     for (i=0;i<n_recvs;i++) {
7598       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7599         new_local_type_private = MATAIJ_PRIVATE;
7600         break;
7601       }
7602       ptr_idxs += olengths_idxs[i];
7603     }
7604     switch (new_local_type_private) {
7605       case MATDENSE_PRIVATE:
7606         new_local_type = MATSEQAIJ;
7607         bs = 1;
7608         break;
7609       case MATAIJ_PRIVATE:
7610         new_local_type = MATSEQAIJ;
7611         bs = 1;
7612         break;
7613       case MATBAIJ_PRIVATE:
7614         new_local_type = MATSEQBAIJ;
7615         break;
7616       case MATSBAIJ_PRIVATE:
7617         new_local_type = MATSEQSBAIJ;
7618         break;
7619       default:
7620         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7621         break;
7622     }
7623   } else { /* by default, new_local_type is seqaij */
7624     new_local_type = MATSEQAIJ;
7625     bs = 1;
7626   }
7627 
7628   /* create MATIS object if needed */
7629   if (!reuse) {
7630     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7631     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7632   } else {
7633     /* it also destroys the local matrices */
7634     if (*mat_n) {
7635       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7636     } else { /* this is a fake object */
7637       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7638     }
7639   }
7640   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7641   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7642 
7643   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7644 
7645   /* Global to local map of received indices */
7646   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7647   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7648   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7649 
7650   /* restore attributes -> type of incoming data and its size */
7651   buf_size_idxs = 0;
7652   for (i=0;i<n_recvs;i++) {
7653     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7654     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7655     buf_size_idxs += (PetscInt)olengths_idxs[i];
7656   }
7657   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7658 
7659   /* set preallocation */
7660   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7661   if (!newisdense) {
7662     PetscInt *new_local_nnz=0;
7663 
7664     ptr_idxs = recv_buffer_idxs_local;
7665     if (n_recvs) {
7666       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7667     }
7668     for (i=0;i<n_recvs;i++) {
7669       PetscInt j;
7670       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7671         for (j=0;j<*(ptr_idxs+1);j++) {
7672           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7673         }
7674       } else {
7675         /* TODO */
7676       }
7677       ptr_idxs += olengths_idxs[i];
7678     }
7679     if (new_local_nnz) {
7680       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7681       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7682       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7683       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7684       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7685       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7686     } else {
7687       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7688     }
7689     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7690   } else {
7691     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7692   }
7693 
7694   /* set values */
7695   ptr_vals = recv_buffer_vals;
7696   ptr_idxs = recv_buffer_idxs_local;
7697   for (i=0;i<n_recvs;i++) {
7698     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7699       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7700       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7701       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7702       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7703       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7704     } else {
7705       /* TODO */
7706     }
7707     ptr_idxs += olengths_idxs[i];
7708     ptr_vals += olengths_vals[i];
7709   }
7710   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7711   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7712   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7713   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7714   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7715   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7716 
7717 #if 0
7718   if (!restrict_comm) { /* check */
7719     Vec       lvec,rvec;
7720     PetscReal infty_error;
7721 
7722     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7723     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7724     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7725     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7726     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7727     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7728     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7729     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7730     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7731   }
7732 #endif
7733 
7734   /* assemble new additional is (if any) */
7735   if (nis) {
7736     PetscInt **temp_idxs,*count_is,j,psum;
7737 
7738     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7739     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7740     ptr_idxs = recv_buffer_idxs_is;
7741     psum = 0;
7742     for (i=0;i<n_recvs;i++) {
7743       for (j=0;j<nis;j++) {
7744         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7745         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7746         psum += plen;
7747         ptr_idxs += plen+1; /* shift pointer to received data */
7748       }
7749     }
7750     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7751     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7752     for (i=1;i<nis;i++) {
7753       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7754     }
7755     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7756     ptr_idxs = recv_buffer_idxs_is;
7757     for (i=0;i<n_recvs;i++) {
7758       for (j=0;j<nis;j++) {
7759         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7760         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7761         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7762         ptr_idxs += plen+1; /* shift pointer to received data */
7763       }
7764     }
7765     for (i=0;i<nis;i++) {
7766       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7767       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7768       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7769     }
7770     ierr = PetscFree(count_is);CHKERRQ(ierr);
7771     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7772     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7773   }
7774   /* free workspace */
7775   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7776   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7777   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7778   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7779   if (isdense) {
7780     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7781     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7782     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7783   } else {
7784     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7785   }
7786   if (nis) {
7787     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7788     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7789   }
7790 
7791   if (nvecs) {
7792     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7793     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7794     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7795     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7796     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7797     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7798     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7799     /* set values */
7800     ptr_vals = recv_buffer_vecs;
7801     ptr_idxs = recv_buffer_idxs_local;
7802     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7803     for (i=0;i<n_recvs;i++) {
7804       PetscInt j;
7805       for (j=0;j<*(ptr_idxs+1);j++) {
7806         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7807       }
7808       ptr_idxs += olengths_idxs[i];
7809       ptr_vals += olengths_idxs[i]-2;
7810     }
7811     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7812     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7813     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7814   }
7815 
7816   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7817   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7818   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7819   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7820   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7821   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7822   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7823   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7824   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7825   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7826   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7827   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7828   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7829   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7830   ierr = PetscFree(onodes);CHKERRQ(ierr);
7831   if (nis) {
7832     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7833     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7834     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7835   }
7836   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7837   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7838     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7839     for (i=0;i<nis;i++) {
7840       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7841     }
7842     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7843       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7844     }
7845     *mat_n = NULL;
7846   }
7847   PetscFunctionReturn(0);
7848 }
7849 
7850 /* temporary hack into ksp private data structure */
7851 #include <petsc/private/kspimpl.h>
7852 
7853 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7854 {
7855   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7856   PC_IS                  *pcis = (PC_IS*)pc->data;
7857   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7858   Mat                    coarsedivudotp = NULL;
7859   Mat                    coarseG,t_coarse_mat_is;
7860   MatNullSpace           CoarseNullSpace = NULL;
7861   ISLocalToGlobalMapping coarse_islg;
7862   IS                     coarse_is,*isarray;
7863   PetscInt               i,im_active=-1,active_procs=-1;
7864   PetscInt               nis,nisdofs,nisneu,nisvert;
7865   PetscInt               coarse_eqs_per_proc;
7866   PC                     pc_temp;
7867   PCType                 coarse_pc_type;
7868   KSPType                coarse_ksp_type;
7869   PetscBool              multilevel_requested,multilevel_allowed;
7870   PetscBool              coarse_reuse;
7871   PetscInt               ncoarse,nedcfield;
7872   PetscBool              compute_vecs = PETSC_FALSE;
7873   PetscScalar            *array;
7874   MatReuse               coarse_mat_reuse;
7875   PetscBool              restr, full_restr, have_void;
7876   PetscMPIInt            size;
7877   PetscErrorCode         ierr;
7878 
7879   PetscFunctionBegin;
7880   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
7881   /* Assign global numbering to coarse dofs */
7882   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 */
7883     PetscInt ocoarse_size;
7884     compute_vecs = PETSC_TRUE;
7885 
7886     pcbddc->new_primal_space = PETSC_TRUE;
7887     ocoarse_size = pcbddc->coarse_size;
7888     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7889     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7890     /* see if we can avoid some work */
7891     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7892       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7893       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7894         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7895         coarse_reuse = PETSC_FALSE;
7896       } else { /* we can safely reuse already computed coarse matrix */
7897         coarse_reuse = PETSC_TRUE;
7898       }
7899     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7900       coarse_reuse = PETSC_FALSE;
7901     }
7902     /* reset any subassembling information */
7903     if (!coarse_reuse || pcbddc->recompute_topography) {
7904       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7905     }
7906   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7907     coarse_reuse = PETSC_TRUE;
7908   }
7909   /* assemble coarse matrix */
7910   if (coarse_reuse && pcbddc->coarse_ksp) {
7911     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7912     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7913     coarse_mat_reuse = MAT_REUSE_MATRIX;
7914   } else {
7915     coarse_mat = NULL;
7916     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7917   }
7918 
7919   /* creates temporary l2gmap and IS for coarse indexes */
7920   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7921   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7922 
7923   /* creates temporary MATIS object for coarse matrix */
7924   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7925   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7926   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7927   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7928   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);
7929   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7930   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7931   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7932   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7933 
7934   /* count "active" (i.e. with positive local size) and "void" processes */
7935   im_active = !!(pcis->n);
7936   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7937 
7938   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7939   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7940   /* full_restr : just use the receivers from the subassembling pattern */
7941   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7942   coarse_mat_is        = NULL;
7943   multilevel_allowed   = PETSC_FALSE;
7944   multilevel_requested = PETSC_FALSE;
7945   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7946   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7947   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
7948   if (multilevel_requested) {
7949     ncoarse    = active_procs/pcbddc->coarsening_ratio;
7950     restr      = PETSC_FALSE;
7951     full_restr = PETSC_FALSE;
7952   } else {
7953     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
7954     restr      = PETSC_TRUE;
7955     full_restr = PETSC_TRUE;
7956   }
7957   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7958   ncoarse = PetscMax(1,ncoarse);
7959   if (!pcbddc->coarse_subassembling) {
7960     if (pcbddc->coarsening_ratio > 1) {
7961       if (multilevel_requested) {
7962         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7963       } else {
7964         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7965       }
7966     } else {
7967       PetscMPIInt rank;
7968       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7969       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7970       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7971     }
7972   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7973     PetscInt    psum;
7974     if (pcbddc->coarse_ksp) psum = 1;
7975     else psum = 0;
7976     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7977     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
7978   }
7979   /* determine if we can go multilevel */
7980   if (multilevel_requested) {
7981     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7982     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7983   }
7984   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7985 
7986   /* dump subassembling pattern */
7987   if (pcbddc->dbg_flag && multilevel_allowed) {
7988     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7989   }
7990   /* compute dofs splitting and neumann boundaries for coarse dofs */
7991   nedcfield = -1;
7992   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7993     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7994     const PetscInt         *idxs;
7995     ISLocalToGlobalMapping tmap;
7996 
7997     /* create map between primal indices (in local representative ordering) and local primal numbering */
7998     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7999     /* allocate space for temporary storage */
8000     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8001     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8002     /* allocate for IS array */
8003     nisdofs = pcbddc->n_ISForDofsLocal;
8004     if (pcbddc->nedclocal) {
8005       if (pcbddc->nedfield > -1) {
8006         nedcfield = pcbddc->nedfield;
8007       } else {
8008         nedcfield = 0;
8009         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8010         nisdofs = 1;
8011       }
8012     }
8013     nisneu = !!pcbddc->NeumannBoundariesLocal;
8014     nisvert = 0; /* nisvert is not used */
8015     nis = nisdofs + nisneu + nisvert;
8016     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8017     /* dofs splitting */
8018     for (i=0;i<nisdofs;i++) {
8019       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8020       if (nedcfield != i) {
8021         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8022         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8023         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8024         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8025       } else {
8026         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8027         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8028         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8029         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8030         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8031       }
8032       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8033       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8034       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8035     }
8036     /* neumann boundaries */
8037     if (pcbddc->NeumannBoundariesLocal) {
8038       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8039       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8040       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8041       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8042       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8043       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8044       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8045       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8046     }
8047     /* free memory */
8048     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8049     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8050     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8051   } else {
8052     nis = 0;
8053     nisdofs = 0;
8054     nisneu = 0;
8055     nisvert = 0;
8056     isarray = NULL;
8057   }
8058   /* destroy no longer needed map */
8059   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8060 
8061   /* subassemble */
8062   if (multilevel_allowed) {
8063     Vec       vp[1];
8064     PetscInt  nvecs = 0;
8065     PetscBool reuse,reuser;
8066 
8067     if (coarse_mat) reuse = PETSC_TRUE;
8068     else reuse = PETSC_FALSE;
8069     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8070     vp[0] = NULL;
8071     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8072       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8073       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8074       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8075       nvecs = 1;
8076 
8077       if (pcbddc->divudotp) {
8078         Mat      B,loc_divudotp;
8079         Vec      v,p;
8080         IS       dummy;
8081         PetscInt np;
8082 
8083         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8084         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8085         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8086         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8087         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8088         ierr = VecSet(p,1.);CHKERRQ(ierr);
8089         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8090         ierr = VecDestroy(&p);CHKERRQ(ierr);
8091         ierr = MatDestroy(&B);CHKERRQ(ierr);
8092         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8093         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8094         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8095         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8096         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8097         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8098         ierr = VecDestroy(&v);CHKERRQ(ierr);
8099       }
8100     }
8101     if (reuser) {
8102       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8103     } else {
8104       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8105     }
8106     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8107       PetscScalar *arraym,*arrayv;
8108       PetscInt    nl;
8109       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8110       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8111       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8112       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8113       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8114       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8115       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8116       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8117     } else {
8118       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8119     }
8120   } else {
8121     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8122   }
8123   if (coarse_mat_is || coarse_mat) {
8124     if (!multilevel_allowed) {
8125       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8126     } else {
8127       Mat A;
8128 
8129       /* if this matrix is present, it means we are not reusing the coarse matrix */
8130       if (coarse_mat_is) {
8131         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8132         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8133         coarse_mat = coarse_mat_is;
8134       }
8135       /* be sure we don't have MatSeqDENSE as local mat */
8136       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8137       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8138     }
8139   }
8140   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8141   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8142 
8143   /* create local to global scatters for coarse problem */
8144   if (compute_vecs) {
8145     PetscInt lrows;
8146     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8147     if (coarse_mat) {
8148       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8149     } else {
8150       lrows = 0;
8151     }
8152     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8153     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8154     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8155     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8156     ierr = VecScatterCreateWithData(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8157   }
8158   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8159 
8160   /* set defaults for coarse KSP and PC */
8161   if (multilevel_allowed) {
8162     coarse_ksp_type = KSPRICHARDSON;
8163     coarse_pc_type  = PCBDDC;
8164   } else {
8165     coarse_ksp_type = KSPPREONLY;
8166     coarse_pc_type  = PCREDUNDANT;
8167   }
8168 
8169   /* print some info if requested */
8170   if (pcbddc->dbg_flag) {
8171     if (!multilevel_allowed) {
8172       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8173       if (multilevel_requested) {
8174         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);
8175       } else if (pcbddc->max_levels) {
8176         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8177       }
8178       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8179     }
8180   }
8181 
8182   /* communicate coarse discrete gradient */
8183   coarseG = NULL;
8184   if (pcbddc->nedcG && multilevel_allowed) {
8185     MPI_Comm ccomm;
8186     if (coarse_mat) {
8187       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8188     } else {
8189       ccomm = MPI_COMM_NULL;
8190     }
8191     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8192   }
8193 
8194   /* create the coarse KSP object only once with defaults */
8195   if (coarse_mat) {
8196     PetscBool   isredundant,isnn,isbddc;
8197     PetscViewer dbg_viewer = NULL;
8198 
8199     if (pcbddc->dbg_flag) {
8200       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8201       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8202     }
8203     if (!pcbddc->coarse_ksp) {
8204       char   prefix[256],str_level[16];
8205       size_t len;
8206 
8207       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8208       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8209       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8210       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8211       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8212       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8213       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8214       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8215       /* TODO is this logic correct? should check for coarse_mat type */
8216       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8217       /* prefix */
8218       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8219       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8220       if (!pcbddc->current_level) {
8221         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8222         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8223       } else {
8224         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8225         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8226         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8227         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8228         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8229         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8230         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8231       }
8232       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8233       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8234       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8235       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8236       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8237       /* allow user customization */
8238       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8239       /* get some info after set from options */
8240       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8241       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8242       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8243       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8244       if (multilevel_allowed && !isbddc && !isnn) {
8245         isbddc = PETSC_TRUE;
8246         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8247         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8248         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8249         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8250       }
8251     }
8252     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8253     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8254     if (nisdofs) {
8255       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8256       for (i=0;i<nisdofs;i++) {
8257         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8258       }
8259     }
8260     if (nisneu) {
8261       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8262       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8263     }
8264     if (nisvert) {
8265       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8266       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8267     }
8268     if (coarseG) {
8269       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8270     }
8271 
8272     /* get some info after set from options */
8273     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8274     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8275     if (isbddc && !multilevel_allowed) {
8276       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8277       isbddc = PETSC_FALSE;
8278     }
8279     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8280     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8281     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8282       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8283       isbddc = PETSC_TRUE;
8284     }
8285     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8286     if (isredundant) {
8287       KSP inner_ksp;
8288       PC  inner_pc;
8289 
8290       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8291       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8292     }
8293 
8294     /* parameters which miss an API */
8295     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8296     if (isbddc) {
8297       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8298 
8299       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8300       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8301       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8302       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8303       if (pcbddc_coarse->benign_saddle_point) {
8304         Mat                    coarsedivudotp_is;
8305         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8306         IS                     row,col;
8307         const PetscInt         *gidxs;
8308         PetscInt               n,st,M,N;
8309 
8310         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8311         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8312         st   = st-n;
8313         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8314         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8315         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8316         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8317         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8318         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8319         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8320         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8321         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8322         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8323         ierr = ISDestroy(&row);CHKERRQ(ierr);
8324         ierr = ISDestroy(&col);CHKERRQ(ierr);
8325         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8326         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8327         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8328         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8329         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8330         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8331         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8332         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8333         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8334         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8335         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8336         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8337       }
8338     }
8339 
8340     /* propagate symmetry info of coarse matrix */
8341     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8342     if (pc->pmat->symmetric_set) {
8343       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8344     }
8345     if (pc->pmat->hermitian_set) {
8346       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8347     }
8348     if (pc->pmat->spd_set) {
8349       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8350     }
8351     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8352       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8353     }
8354     /* set operators */
8355     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8356     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8357     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8358     if (pcbddc->dbg_flag) {
8359       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8360     }
8361   }
8362   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8363   ierr = PetscFree(isarray);CHKERRQ(ierr);
8364 #if 0
8365   {
8366     PetscViewer viewer;
8367     char filename[256];
8368     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8369     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8370     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8371     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8372     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8373     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8374   }
8375 #endif
8376 
8377   if (pcbddc->coarse_ksp) {
8378     Vec crhs,csol;
8379 
8380     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8381     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8382     if (!csol) {
8383       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8384     }
8385     if (!crhs) {
8386       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8387     }
8388   }
8389   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8390 
8391   /* compute null space for coarse solver if the benign trick has been requested */
8392   if (pcbddc->benign_null) {
8393 
8394     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8395     for (i=0;i<pcbddc->benign_n;i++) {
8396       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8397     }
8398     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8399     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8400     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8401     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8402     if (coarse_mat) {
8403       Vec         nullv;
8404       PetscScalar *array,*array2;
8405       PetscInt    nl;
8406 
8407       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8408       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8409       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8410       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8411       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8412       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8413       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8414       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8415       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8416       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8417     }
8418   }
8419   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8420 
8421   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8422   if (pcbddc->coarse_ksp) {
8423     PetscBool ispreonly;
8424 
8425     if (CoarseNullSpace) {
8426       PetscBool isnull;
8427       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8428       if (isnull) {
8429         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8430       }
8431       /* TODO: add local nullspaces (if any) */
8432     }
8433     /* setup coarse ksp */
8434     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8435     /* Check coarse problem if in debug mode or if solving with an iterative method */
8436     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8437     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8438       KSP       check_ksp;
8439       KSPType   check_ksp_type;
8440       PC        check_pc;
8441       Vec       check_vec,coarse_vec;
8442       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8443       PetscInt  its;
8444       PetscBool compute_eigs;
8445       PetscReal *eigs_r,*eigs_c;
8446       PetscInt  neigs;
8447       const char *prefix;
8448 
8449       /* Create ksp object suitable for estimation of extreme eigenvalues */
8450       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8451       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8452       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8453       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8454       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8455       /* prevent from setup unneeded object */
8456       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8457       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8458       if (ispreonly) {
8459         check_ksp_type = KSPPREONLY;
8460         compute_eigs = PETSC_FALSE;
8461       } else {
8462         check_ksp_type = KSPGMRES;
8463         compute_eigs = PETSC_TRUE;
8464       }
8465       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8466       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8467       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8468       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8469       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8470       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8471       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8472       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8473       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8474       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8475       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8476       /* create random vec */
8477       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8478       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8479       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8480       /* solve coarse problem */
8481       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8482       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8483       /* set eigenvalue estimation if preonly has not been requested */
8484       if (compute_eigs) {
8485         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8486         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8487         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8488         if (neigs) {
8489           lambda_max = eigs_r[neigs-1];
8490           lambda_min = eigs_r[0];
8491           if (pcbddc->use_coarse_estimates) {
8492             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8493               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8494               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8495             }
8496           }
8497         }
8498       }
8499 
8500       /* check coarse problem residual error */
8501       if (pcbddc->dbg_flag) {
8502         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8503         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8504         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8505         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8506         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8507         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8508         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8509         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8510         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8511         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8512         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8513         if (CoarseNullSpace) {
8514           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8515         }
8516         if (compute_eigs) {
8517           PetscReal          lambda_max_s,lambda_min_s;
8518           KSPConvergedReason reason;
8519           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8520           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8521           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8522           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8523           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);
8524           for (i=0;i<neigs;i++) {
8525             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8526           }
8527         }
8528         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8529         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8530       }
8531       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8532       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8533       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8534       if (compute_eigs) {
8535         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8536         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8537       }
8538     }
8539   }
8540   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8541   /* print additional info */
8542   if (pcbddc->dbg_flag) {
8543     /* waits until all processes reaches this point */
8544     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8545     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8546     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8547   }
8548 
8549   /* free memory */
8550   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8551   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8552   PetscFunctionReturn(0);
8553 }
8554 
8555 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8556 {
8557   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8558   PC_IS*         pcis = (PC_IS*)pc->data;
8559   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8560   IS             subset,subset_mult,subset_n;
8561   PetscInt       local_size,coarse_size=0;
8562   PetscInt       *local_primal_indices=NULL;
8563   const PetscInt *t_local_primal_indices;
8564   PetscErrorCode ierr;
8565 
8566   PetscFunctionBegin;
8567   /* Compute global number of coarse dofs */
8568   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8569   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8570   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8571   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8572   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8573   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8574   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8575   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8576   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8577   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);
8578   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8579   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8580   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8581   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8582   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8583 
8584   /* check numbering */
8585   if (pcbddc->dbg_flag) {
8586     PetscScalar coarsesum,*array,*array2;
8587     PetscInt    i;
8588     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8589 
8590     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8591     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8592     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8593     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8594     /* counter */
8595     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8596     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8597     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8598     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8599     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8600     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8601     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8602     for (i=0;i<pcbddc->local_primal_size;i++) {
8603       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8604     }
8605     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8606     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8607     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8608     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8609     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8610     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8611     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8612     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8613     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8614     for (i=0;i<pcis->n;i++) {
8615       if (array[i] != 0.0 && array[i] != array2[i]) {
8616         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8617         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8618         set_error = PETSC_TRUE;
8619         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8620         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);
8621       }
8622     }
8623     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8624     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8625     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8626     for (i=0;i<pcis->n;i++) {
8627       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8628     }
8629     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8630     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8631     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8632     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8633     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8634     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8635     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8636       PetscInt *gidxs;
8637 
8638       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8639       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8640       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8641       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8642       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8643       for (i=0;i<pcbddc->local_primal_size;i++) {
8644         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);
8645       }
8646       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8647       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8648     }
8649     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8650     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8651     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8652   }
8653 
8654   /* get back data */
8655   *coarse_size_n = coarse_size;
8656   *local_primal_indices_n = local_primal_indices;
8657   PetscFunctionReturn(0);
8658 }
8659 
8660 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8661 {
8662   IS             localis_t;
8663   PetscInt       i,lsize,*idxs,n;
8664   PetscScalar    *vals;
8665   PetscErrorCode ierr;
8666 
8667   PetscFunctionBegin;
8668   /* get indices in local ordering exploiting local to global map */
8669   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8670   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8671   for (i=0;i<lsize;i++) vals[i] = 1.0;
8672   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8673   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8674   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8675   if (idxs) { /* multilevel guard */
8676     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8677     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8678   }
8679   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8680   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8681   ierr = PetscFree(vals);CHKERRQ(ierr);
8682   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8683   /* now compute set in local ordering */
8684   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8685   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8686   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8687   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8688   for (i=0,lsize=0;i<n;i++) {
8689     if (PetscRealPart(vals[i]) > 0.5) {
8690       lsize++;
8691     }
8692   }
8693   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8694   for (i=0,lsize=0;i<n;i++) {
8695     if (PetscRealPart(vals[i]) > 0.5) {
8696       idxs[lsize++] = i;
8697     }
8698   }
8699   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8700   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8701   *localis = localis_t;
8702   PetscFunctionReturn(0);
8703 }
8704 
8705 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8706 {
8707   PC_IS               *pcis=(PC_IS*)pc->data;
8708   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8709   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8710   Mat                 S_j;
8711   PetscInt            *used_xadj,*used_adjncy;
8712   PetscBool           free_used_adj;
8713   PetscErrorCode      ierr;
8714 
8715   PetscFunctionBegin;
8716   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8717   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8718   free_used_adj = PETSC_FALSE;
8719   if (pcbddc->sub_schurs_layers == -1) {
8720     used_xadj = NULL;
8721     used_adjncy = NULL;
8722   } else {
8723     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8724       used_xadj = pcbddc->mat_graph->xadj;
8725       used_adjncy = pcbddc->mat_graph->adjncy;
8726     } else if (pcbddc->computed_rowadj) {
8727       used_xadj = pcbddc->mat_graph->xadj;
8728       used_adjncy = pcbddc->mat_graph->adjncy;
8729     } else {
8730       PetscBool      flg_row=PETSC_FALSE;
8731       const PetscInt *xadj,*adjncy;
8732       PetscInt       nvtxs;
8733 
8734       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8735       if (flg_row) {
8736         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8737         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8738         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8739         free_used_adj = PETSC_TRUE;
8740       } else {
8741         pcbddc->sub_schurs_layers = -1;
8742         used_xadj = NULL;
8743         used_adjncy = NULL;
8744       }
8745       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8746     }
8747   }
8748 
8749   /* setup sub_schurs data */
8750   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8751   if (!sub_schurs->schur_explicit) {
8752     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8753     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8754     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);
8755   } else {
8756     Mat       change = NULL;
8757     Vec       scaling = NULL;
8758     IS        change_primal = NULL, iP;
8759     PetscInt  benign_n;
8760     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8761     PetscBool isseqaij,need_change = PETSC_FALSE;
8762     PetscBool discrete_harmonic = PETSC_FALSE;
8763 
8764     if (!pcbddc->use_vertices && reuse_solvers) {
8765       PetscInt n_vertices;
8766 
8767       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8768       reuse_solvers = (PetscBool)!n_vertices;
8769     }
8770     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8771     if (!isseqaij) {
8772       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8773       if (matis->A == pcbddc->local_mat) {
8774         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8775         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8776       } else {
8777         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8778       }
8779     }
8780     if (!pcbddc->benign_change_explicit) {
8781       benign_n = pcbddc->benign_n;
8782     } else {
8783       benign_n = 0;
8784     }
8785     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8786        We need a global reduction to avoid possible deadlocks.
8787        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8788     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8789       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8790       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8791       need_change = (PetscBool)(!need_change);
8792     }
8793     /* If the user defines additional constraints, we import them here.
8794        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 */
8795     if (need_change) {
8796       PC_IS   *pcisf;
8797       PC_BDDC *pcbddcf;
8798       PC      pcf;
8799 
8800       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8801       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8802       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8803       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8804 
8805       /* hacks */
8806       pcisf                        = (PC_IS*)pcf->data;
8807       pcisf->is_B_local            = pcis->is_B_local;
8808       pcisf->vec1_N                = pcis->vec1_N;
8809       pcisf->BtoNmap               = pcis->BtoNmap;
8810       pcisf->n                     = pcis->n;
8811       pcisf->n_B                   = pcis->n_B;
8812       pcbddcf                      = (PC_BDDC*)pcf->data;
8813       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8814       pcbddcf->mat_graph           = pcbddc->mat_graph;
8815       pcbddcf->use_faces           = PETSC_TRUE;
8816       pcbddcf->use_change_of_basis = PETSC_TRUE;
8817       pcbddcf->use_change_on_faces = PETSC_TRUE;
8818       pcbddcf->use_qr_single       = PETSC_TRUE;
8819       pcbddcf->fake_change         = PETSC_TRUE;
8820 
8821       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8822       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8823       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8824       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8825       change = pcbddcf->ConstraintMatrix;
8826       pcbddcf->ConstraintMatrix = NULL;
8827 
8828       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8829       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8830       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8831       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8832       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8833       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8834       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8835       pcf->ops->destroy = NULL;
8836       pcf->ops->reset   = NULL;
8837       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8838     }
8839     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8840 
8841     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8842     if (iP) {
8843       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8844       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8845       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8846     }
8847     if (discrete_harmonic) {
8848       Mat A;
8849       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8850       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8851       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8852       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);
8853       ierr = MatDestroy(&A);CHKERRQ(ierr);
8854     } else {
8855       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);
8856     }
8857     ierr = MatDestroy(&change);CHKERRQ(ierr);
8858     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8859   }
8860   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8861 
8862   /* free adjacency */
8863   if (free_used_adj) {
8864     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8865   }
8866   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8867   PetscFunctionReturn(0);
8868 }
8869 
8870 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8871 {
8872   PC_IS               *pcis=(PC_IS*)pc->data;
8873   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8874   PCBDDCGraph         graph;
8875   PetscErrorCode      ierr;
8876 
8877   PetscFunctionBegin;
8878   /* attach interface graph for determining subsets */
8879   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8880     IS       verticesIS,verticescomm;
8881     PetscInt vsize,*idxs;
8882 
8883     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8884     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8885     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8886     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8887     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8888     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8889     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8890     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8891     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8892     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8893     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8894   } else {
8895     graph = pcbddc->mat_graph;
8896   }
8897   /* print some info */
8898   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8899     IS       vertices;
8900     PetscInt nv,nedges,nfaces;
8901     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8902     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8903     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8904     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8905     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8906     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
8907     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
8908     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8909     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8910     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8911     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8912   }
8913 
8914   /* sub_schurs init */
8915   if (!pcbddc->sub_schurs) {
8916     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8917   }
8918   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);
8919 
8920   /* free graph struct */
8921   if (pcbddc->sub_schurs_rebuild) {
8922     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8923   }
8924   PetscFunctionReturn(0);
8925 }
8926 
8927 PetscErrorCode PCBDDCCheckOperator(PC pc)
8928 {
8929   PC_IS               *pcis=(PC_IS*)pc->data;
8930   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8931   PetscErrorCode      ierr;
8932 
8933   PetscFunctionBegin;
8934   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8935     IS             zerodiag = NULL;
8936     Mat            S_j,B0_B=NULL;
8937     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8938     PetscScalar    *p0_check,*array,*array2;
8939     PetscReal      norm;
8940     PetscInt       i;
8941 
8942     /* B0 and B0_B */
8943     if (zerodiag) {
8944       IS       dummy;
8945 
8946       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8947       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8948       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8949       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8950     }
8951     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8952     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8953     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8954     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8955     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8956     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8957     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8958     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8959     /* S_j */
8960     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8961     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8962 
8963     /* mimic vector in \widetilde{W}_\Gamma */
8964     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8965     /* continuous in primal space */
8966     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8967     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8968     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8969     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8970     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8971     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8972     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8973     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8974     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8975     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8976     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8977     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8978     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8979     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8980 
8981     /* assemble rhs for coarse problem */
8982     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8983     /* local with Schur */
8984     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8985     if (zerodiag) {
8986       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8987       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8988       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8989       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8990     }
8991     /* sum on primal nodes the local contributions */
8992     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8993     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8994     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8995     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8996     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8997     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8998     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8999     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9000     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9001     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9002     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9003     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9004     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9005     /* scale primal nodes (BDDC sums contibutions) */
9006     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9007     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9008     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9009     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9010     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9011     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9012     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9013     /* global: \widetilde{B0}_B w_\Gamma */
9014     if (zerodiag) {
9015       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9016       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9017       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9018       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9019     }
9020     /* BDDC */
9021     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9022     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9023 
9024     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9025     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9026     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9027     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9028     for (i=0;i<pcbddc->benign_n;i++) {
9029       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);
9030     }
9031     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9032     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9033     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9034     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9035     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9036     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9037   }
9038   PetscFunctionReturn(0);
9039 }
9040 
9041 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9042 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9043 {
9044   Mat            At;
9045   IS             rows;
9046   PetscInt       rst,ren;
9047   PetscErrorCode ierr;
9048   PetscLayout    rmap;
9049 
9050   PetscFunctionBegin;
9051   rst = ren = 0;
9052   if (ccomm != MPI_COMM_NULL) {
9053     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9054     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9055     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9056     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9057     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9058   }
9059   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9060   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9061   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9062 
9063   if (ccomm != MPI_COMM_NULL) {
9064     Mat_MPIAIJ *a,*b;
9065     IS         from,to;
9066     Vec        gvec;
9067     PetscInt   lsize;
9068 
9069     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9070     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9071     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9072     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9073     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9074     a    = (Mat_MPIAIJ*)At->data;
9075     b    = (Mat_MPIAIJ*)(*B)->data;
9076     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9077     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9078     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9079     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9080     b->A = a->A;
9081     b->B = a->B;
9082 
9083     b->donotstash      = a->donotstash;
9084     b->roworiented     = a->roworiented;
9085     b->rowindices      = 0;
9086     b->rowvalues       = 0;
9087     b->getrowactive    = PETSC_FALSE;
9088 
9089     (*B)->rmap         = rmap;
9090     (*B)->factortype   = A->factortype;
9091     (*B)->assembled    = PETSC_TRUE;
9092     (*B)->insertmode   = NOT_SET_VALUES;
9093     (*B)->preallocated = PETSC_TRUE;
9094 
9095     if (a->colmap) {
9096 #if defined(PETSC_USE_CTABLE)
9097       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9098 #else
9099       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9100       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9101       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9102 #endif
9103     } else b->colmap = 0;
9104     if (a->garray) {
9105       PetscInt len;
9106       len  = a->B->cmap->n;
9107       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9108       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9109       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9110     } else b->garray = 0;
9111 
9112     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9113     b->lvec = a->lvec;
9114     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9115 
9116     /* cannot use VecScatterCopy */
9117     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9118     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9119     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9120     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9121     ierr = VecScatterCreateWithData(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9122     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9123     ierr = ISDestroy(&from);CHKERRQ(ierr);
9124     ierr = ISDestroy(&to);CHKERRQ(ierr);
9125     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9126   }
9127   ierr = MatDestroy(&At);CHKERRQ(ierr);
9128   PetscFunctionReturn(0);
9129 }
9130