xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 8ead10e4547184aac0573c86903e0a49aa57eabe)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat               GEc;
121     const PetscScalar *vals;
122     PetscScalar       v;
123 
124     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
125     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
126     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
127     /* v    = PetscAbsScalar(vals[0]) */;
128     v    = 1.;
129     cvals[0] = vals[0]/v;
130     cvals[1] = vals[1]/v;
131     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
132     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
133 #if defined(PRINT_GDET)
134     {
135       PetscViewer viewer;
136       char filename[256];
137       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
138       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
139       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
141       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
142       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
143       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
144       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
145       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
146       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
147     }
148 #endif
149     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
150     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
151   }
152 
153   PetscFunctionReturn(0);
154 }
155 
156 PetscErrorCode PCBDDCNedelecSupport(PC pc)
157 {
158   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
159   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
160   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
161   Vec                    tvec;
162   PetscSF                sfv;
163   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
164   MPI_Comm               comm;
165   IS                     lned,primals,allprimals,nedfieldlocal;
166   IS                     *eedges,*extrows,*extcols,*alleedges;
167   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
168   PetscScalar            *vals,*work;
169   PetscReal              *rwork;
170   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
171   PetscInt               ne,nv,Lv,order,n,field;
172   PetscInt               n_neigh,*neigh,*n_shared,**shared;
173   PetscInt               i,j,extmem,cum,maxsize,nee;
174   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
175   PetscInt               *sfvleaves,*sfvroots;
176   PetscInt               *corners,*cedges;
177   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
178 #if defined(PETSC_USE_DEBUG)
179   PetscInt               *emarks;
180 #endif
181   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
182   PetscErrorCode         ierr;
183 
184   PetscFunctionBegin;
185   /* If the discrete gradient is defined for a subset of dofs and global is true,
186      it assumes G is given in global ordering for all the dofs.
187      Otherwise, the ordering is global for the Nedelec field */
188   order      = pcbddc->nedorder;
189   conforming = pcbddc->conforming;
190   field      = pcbddc->nedfield;
191   global     = pcbddc->nedglobal;
192   setprimal  = PETSC_FALSE;
193   print      = PETSC_FALSE;
194   singular   = PETSC_FALSE;
195 
196   /* Command line customization */
197   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
201   /* print debug info TODO: to be removed */
202   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
203   ierr = PetscOptionsEnd();CHKERRQ(ierr);
204 
205   /* Return if there are no edges in the decomposition and the problem is not singular */
206   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
207   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
208   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
209   if (!singular) {
210     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
211     lrc[0] = PETSC_FALSE;
212     for (i=0;i<n;i++) {
213       if (PetscRealPart(vals[i]) > 2.) {
214         lrc[0] = PETSC_TRUE;
215         break;
216       }
217     }
218     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
219     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
220     if (!lrc[1]) PetscFunctionReturn(0);
221   }
222 
223   /* Get Nedelec field */
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %D: number of fields is %D",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
237     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %D it's not a multiple of the order %D",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
324   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %D connected with nodal dof %D with order %D",test,i,ord);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
638   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
836       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %D: mark %D (ref mark %D), boundary %D\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %D and %D) connected through the %D nodal dof at edge dof %D",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1183     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       const PetscScalar *data;
1281       const PetscInt    *rows,*cols;
1282       PetscInt          nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %D and Gins %D does not match %D for coarse edge %D",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %D with ncc %D",i,ncc);
1297       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize,*gidxs;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1491   }
1492 
1493   /* compute local quad vec */
1494   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1495   if (!transpose) {
1496     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1497   } else {
1498     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1499   }
1500   ierr = VecSet(p,1.);CHKERRQ(ierr);
1501   if (!transpose) {
1502     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1503   } else {
1504     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1505   }
1506   if (vl2l) {
1507     Mat        lA;
1508     VecScatter sc;
1509 
1510     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1511     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1512     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1513     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1516   } else {
1517     vins = v;
1518   }
1519   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1520   ierr = VecDestroy(&p);CHKERRQ(ierr);
1521 
1522   /* insert in global quadrature vecs */
1523   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1524   for (i=0;i<n_neigh;i++) {
1525     const PetscInt    *idxs;
1526     PetscInt          idx,nn,j;
1527 
1528     idxs = shared[i];
1529     nn   = n_shared[i];
1530     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1531     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1532     idx  = -(idx+1);
1533     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1534     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614 
1615       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1616       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1617         PetscInt bs;
1618 
1619         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1620         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1621         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1622         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1623       }
1624       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1625       pcbddc->n_ISForDofs = 0;
1626       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1627     }
1628   } else {
1629     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1630       DM dm;
1631 
1632       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1633       if (!dm) {
1634         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1635       }
1636       if (dm) {
1637         IS      *fields;
1638         PetscInt nf,i;
1639 
1640         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1641         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1642         for (i=0;i<nf;i++) {
1643           PetscInt bs;
1644 
1645           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1646           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1647           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1648           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1649         }
1650         ierr = PetscFree(fields);CHKERRQ(ierr);
1651         pcbddc->n_ISForDofsLocal = nf;
1652       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1653         PetscContainer   c;
1654 
1655         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1656         if (c) {
1657           MatISLocalFields lf;
1658           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1659           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1660         } else { /* fallback, create the default fields if bs > 1 */
1661           PetscInt i, n = matis->A->rmap->n;
1662           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1663           if (i > 1) {
1664             pcbddc->n_ISForDofsLocal = i;
1665             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1666             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1667               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1668             }
1669           }
1670         }
1671       }
1672     } else {
1673       PetscInt i;
1674       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1675         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1676       }
1677     }
1678   }
1679 
1680 boundary:
1681   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1683   } else if (pcbddc->DirichletBoundariesLocal) {
1684     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1685   }
1686   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1687     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1688   } else if (pcbddc->NeumannBoundariesLocal) {
1689     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1690   }
1691   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1692     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1693   }
1694   ierr = VecDestroy(&global);CHKERRQ(ierr);
1695   ierr = VecDestroy(&local);CHKERRQ(ierr);
1696   /* detect local disconnected subdomains if requested (use matis->A) */
1697   if (pcbddc->detect_disconnected) {
1698     IS        primalv = NULL;
1699     PetscInt  i;
1700     PetscBool filter = pcbddc->detect_disconnected_filter;
1701 
1702     for (i=0;i<pcbddc->n_local_subs;i++) {
1703       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1704     }
1705     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1706     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1707     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1708     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1709   }
1710   /* early stage corner detection */
1711   {
1712     DM dm;
1713 
1714     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1715     if (!dm) {
1716       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1717     }
1718     if (dm) {
1719       PetscBool isda;
1720 
1721       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1722       if (isda) {
1723         ISLocalToGlobalMapping l2l;
1724         IS                     corners;
1725         Mat                    lA;
1726         PetscBool              gl,lo;
1727 
1728         {
1729           Vec               cvec;
1730           const PetscScalar *coords;
1731           PetscInt          dof,n,cdim;
1732           PetscBool         memc = PETSC_TRUE;
1733 
1734           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1735           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1736           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1737           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1738           n   /= cdim;
1739           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1740           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1741           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1742 #if defined(PETSC_USE_COMPLEX)
1743           memc = PETSC_FALSE;
1744 #endif
1745           if (dof != 1) memc = PETSC_FALSE;
1746           if (memc) {
1747             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1748           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1749             PetscReal *bcoords = pcbddc->mat_graph->coords;
1750             PetscInt  i, b, d;
1751 
1752             for (i=0;i<n;i++) {
1753               for (b=0;b<dof;b++) {
1754                 for (d=0;d<cdim;d++) {
1755                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1756                 }
1757               }
1758             }
1759           }
1760           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1761           pcbddc->mat_graph->cdim  = cdim;
1762           pcbddc->mat_graph->cnloc = dof*n;
1763           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1764         }
1765         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1766         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1767         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1768         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1769         lo   = (PetscBool)(l2l && corners);
1770         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1771         if (gl) { /* From PETSc's DMDA */
1772           const PetscInt    *idx;
1773           PetscInt          dof,bs,*idxout,n;
1774 
1775           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1776           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1777           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1778           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1779           if (bs == dof) {
1780             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1781             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1782           } else { /* the original DMDA local-to-local map have been modified */
1783             PetscInt i,d;
1784 
1785             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1786             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1787             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1788 
1789             bs = 1;
1790             n *= dof;
1791           }
1792           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1793           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1794           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1795           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1796           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1797           pcbddc->corner_selected  = PETSC_TRUE;
1798           pcbddc->corner_selection = PETSC_TRUE;
1799         }
1800         if (corners) {
1801           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1802         }
1803       }
1804     }
1805   }
1806   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1807     DM dm;
1808 
1809     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1810     if (!dm) {
1811       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1812     }
1813     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1814       Vec            vcoords;
1815       PetscSection   section;
1816       PetscReal      *coords;
1817       PetscInt       d,cdim,nl,nf,**ctxs;
1818       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1819 
1820       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1821       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1822       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1823       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1824       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1825       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1826       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1827       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1828       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1829       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1830       for (d=0;d<cdim;d++) {
1831         PetscInt          i;
1832         const PetscScalar *v;
1833 
1834         for (i=0;i<nf;i++) ctxs[i][0] = d;
1835         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1836         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1837         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1838         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1839       }
1840       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1841       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1842       ierr = PetscFree(coords);CHKERRQ(ierr);
1843       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1844       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1845     }
1846   }
1847   PetscFunctionReturn(0);
1848 }
1849 
1850 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1851 {
1852   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1853   PetscErrorCode  ierr;
1854   IS              nis;
1855   const PetscInt  *idxs;
1856   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1857   PetscBool       *ld;
1858 
1859   PetscFunctionBegin;
1860   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1861   if (mop == MPI_LAND) {
1862     /* init rootdata with true */
1863     ld   = (PetscBool*) matis->sf_rootdata;
1864     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1865   } else {
1866     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1867   }
1868   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1869   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1870   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1871   ld   = (PetscBool*) matis->sf_leafdata;
1872   for (i=0;i<nd;i++)
1873     if (-1 < idxs[i] && idxs[i] < n)
1874       ld[idxs[i]] = PETSC_TRUE;
1875   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1876   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1877   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1878   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1879   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1880   if (mop == MPI_LAND) {
1881     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1882   } else {
1883     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1884   }
1885   for (i=0,nnd=0;i<n;i++)
1886     if (ld[i])
1887       nidxs[nnd++] = i;
1888   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1889   ierr = ISDestroy(is);CHKERRQ(ierr);
1890   *is  = nis;
1891   PetscFunctionReturn(0);
1892 }
1893 
1894 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1895 {
1896   PC_IS             *pcis = (PC_IS*)(pc->data);
1897   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1898   PetscErrorCode    ierr;
1899 
1900   PetscFunctionBegin;
1901   if (!pcbddc->benign_have_null) {
1902     PetscFunctionReturn(0);
1903   }
1904   if (pcbddc->ChangeOfBasisMatrix) {
1905     Vec swap;
1906 
1907     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1908     swap = pcbddc->work_change;
1909     pcbddc->work_change = r;
1910     r = swap;
1911   }
1912   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1913   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1914   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1915   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1916   ierr = VecSet(z,0.);CHKERRQ(ierr);
1917   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1918   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1919   if (pcbddc->ChangeOfBasisMatrix) {
1920     pcbddc->work_change = r;
1921     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1922     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1923   }
1924   PetscFunctionReturn(0);
1925 }
1926 
1927 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1928 {
1929   PCBDDCBenignMatMult_ctx ctx;
1930   PetscErrorCode          ierr;
1931   PetscBool               apply_right,apply_left,reset_x;
1932 
1933   PetscFunctionBegin;
1934   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1935   if (transpose) {
1936     apply_right = ctx->apply_left;
1937     apply_left = ctx->apply_right;
1938   } else {
1939     apply_right = ctx->apply_right;
1940     apply_left = ctx->apply_left;
1941   }
1942   reset_x = PETSC_FALSE;
1943   if (apply_right) {
1944     const PetscScalar *ax;
1945     PetscInt          nl,i;
1946 
1947     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1948     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1949     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1950     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1951     for (i=0;i<ctx->benign_n;i++) {
1952       PetscScalar    sum,val;
1953       const PetscInt *idxs;
1954       PetscInt       nz,j;
1955       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1956       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1957       sum = 0.;
1958       if (ctx->apply_p0) {
1959         val = ctx->work[idxs[nz-1]];
1960         for (j=0;j<nz-1;j++) {
1961           sum += ctx->work[idxs[j]];
1962           ctx->work[idxs[j]] += val;
1963         }
1964       } else {
1965         for (j=0;j<nz-1;j++) {
1966           sum += ctx->work[idxs[j]];
1967         }
1968       }
1969       ctx->work[idxs[nz-1]] -= sum;
1970       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1971     }
1972     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1973     reset_x = PETSC_TRUE;
1974   }
1975   if (transpose) {
1976     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1977   } else {
1978     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1979   }
1980   if (reset_x) {
1981     ierr = VecResetArray(x);CHKERRQ(ierr);
1982   }
1983   if (apply_left) {
1984     PetscScalar *ay;
1985     PetscInt    i;
1986 
1987     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1988     for (i=0;i<ctx->benign_n;i++) {
1989       PetscScalar    sum,val;
1990       const PetscInt *idxs;
1991       PetscInt       nz,j;
1992       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1993       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1994       val = -ay[idxs[nz-1]];
1995       if (ctx->apply_p0) {
1996         sum = 0.;
1997         for (j=0;j<nz-1;j++) {
1998           sum += ay[idxs[j]];
1999           ay[idxs[j]] += val;
2000         }
2001         ay[idxs[nz-1]] += sum;
2002       } else {
2003         for (j=0;j<nz-1;j++) {
2004           ay[idxs[j]] += val;
2005         }
2006         ay[idxs[nz-1]] = 0.;
2007       }
2008       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2009     }
2010     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2011   }
2012   PetscFunctionReturn(0);
2013 }
2014 
2015 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2016 {
2017   PetscErrorCode ierr;
2018 
2019   PetscFunctionBegin;
2020   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2021   PetscFunctionReturn(0);
2022 }
2023 
2024 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2025 {
2026   PetscErrorCode ierr;
2027 
2028   PetscFunctionBegin;
2029   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2030   PetscFunctionReturn(0);
2031 }
2032 
2033 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2034 {
2035   PC_IS                   *pcis = (PC_IS*)pc->data;
2036   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2037   PCBDDCBenignMatMult_ctx ctx;
2038   PetscErrorCode          ierr;
2039 
2040   PetscFunctionBegin;
2041   if (!restore) {
2042     Mat                A_IB,A_BI;
2043     PetscScalar        *work;
2044     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2045 
2046     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2047     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2048     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2049     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2050     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2051     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2052     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2053     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2054     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2055     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2056     ctx->apply_left = PETSC_TRUE;
2057     ctx->apply_right = PETSC_FALSE;
2058     ctx->apply_p0 = PETSC_FALSE;
2059     ctx->benign_n = pcbddc->benign_n;
2060     if (reuse) {
2061       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2062       ctx->free = PETSC_FALSE;
2063     } else { /* TODO: could be optimized for successive solves */
2064       ISLocalToGlobalMapping N_to_D;
2065       PetscInt               i;
2066 
2067       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2068       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2069       for (i=0;i<pcbddc->benign_n;i++) {
2070         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2071       }
2072       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2073       ctx->free = PETSC_TRUE;
2074     }
2075     ctx->A = pcis->A_IB;
2076     ctx->work = work;
2077     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2078     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2079     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2080     pcis->A_IB = A_IB;
2081 
2082     /* A_BI as A_IB^T */
2083     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2084     pcbddc->benign_original_mat = pcis->A_BI;
2085     pcis->A_BI = A_BI;
2086   } else {
2087     if (!pcbddc->benign_original_mat) {
2088       PetscFunctionReturn(0);
2089     }
2090     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2091     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2092     pcis->A_IB = ctx->A;
2093     ctx->A = NULL;
2094     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2095     pcis->A_BI = pcbddc->benign_original_mat;
2096     pcbddc->benign_original_mat = NULL;
2097     if (ctx->free) {
2098       PetscInt i;
2099       for (i=0;i<ctx->benign_n;i++) {
2100         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2101       }
2102       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2103     }
2104     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2105     ierr = PetscFree(ctx);CHKERRQ(ierr);
2106   }
2107   PetscFunctionReturn(0);
2108 }
2109 
2110 /* used just in bddc debug mode */
2111 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2112 {
2113   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2114   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2115   Mat            An;
2116   PetscErrorCode ierr;
2117 
2118   PetscFunctionBegin;
2119   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2120   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2121   if (is1) {
2122     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2123     ierr = MatDestroy(&An);CHKERRQ(ierr);
2124   } else {
2125     *B = An;
2126   }
2127   PetscFunctionReturn(0);
2128 }
2129 
2130 /* TODO: add reuse flag */
2131 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2132 {
2133   Mat            Bt;
2134   PetscScalar    *a,*bdata;
2135   const PetscInt *ii,*ij;
2136   PetscInt       m,n,i,nnz,*bii,*bij;
2137   PetscBool      flg_row;
2138   PetscErrorCode ierr;
2139 
2140   PetscFunctionBegin;
2141   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2142   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2143   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2144   nnz = n;
2145   for (i=0;i<ii[n];i++) {
2146     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2147   }
2148   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2149   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2150   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2151   nnz = 0;
2152   bii[0] = 0;
2153   for (i=0;i<n;i++) {
2154     PetscInt j;
2155     for (j=ii[i];j<ii[i+1];j++) {
2156       PetscScalar entry = a[j];
2157       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2158         bij[nnz] = ij[j];
2159         bdata[nnz] = entry;
2160         nnz++;
2161       }
2162     }
2163     bii[i+1] = nnz;
2164   }
2165   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2166   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2167   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2168   {
2169     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2170     b->free_a = PETSC_TRUE;
2171     b->free_ij = PETSC_TRUE;
2172   }
2173   if (*B == A) {
2174     ierr = MatDestroy(&A);CHKERRQ(ierr);
2175   }
2176   *B = Bt;
2177   PetscFunctionReturn(0);
2178 }
2179 
2180 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2181 {
2182   Mat                    B = NULL;
2183   DM                     dm;
2184   IS                     is_dummy,*cc_n;
2185   ISLocalToGlobalMapping l2gmap_dummy;
2186   PCBDDCGraph            graph;
2187   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2188   PetscInt               i,n;
2189   PetscInt               *xadj,*adjncy;
2190   PetscBool              isplex = PETSC_FALSE;
2191   PetscErrorCode         ierr;
2192 
2193   PetscFunctionBegin;
2194   if (ncc) *ncc = 0;
2195   if (cc) *cc = NULL;
2196   if (primalv) *primalv = NULL;
2197   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2198   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2199   if (!dm) {
2200     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2201   }
2202   if (dm) {
2203     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2204   }
2205   if (filter) isplex = PETSC_FALSE;
2206 
2207   if (isplex) { /* this code has been modified from plexpartition.c */
2208     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2209     PetscInt      *adj = NULL;
2210     IS             cellNumbering;
2211     const PetscInt *cellNum;
2212     PetscBool      useCone, useClosure;
2213     PetscSection   section;
2214     PetscSegBuffer adjBuffer;
2215     PetscSF        sfPoint;
2216     PetscErrorCode ierr;
2217 
2218     PetscFunctionBegin;
2219     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2220     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2221     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2222     /* Build adjacency graph via a section/segbuffer */
2223     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2224     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2225     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2226     /* Always use FVM adjacency to create partitioner graph */
2227     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2228     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2229     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2230     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2231     for (n = 0, p = pStart; p < pEnd; p++) {
2232       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2233       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2234       adjSize = PETSC_DETERMINE;
2235       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2236       for (a = 0; a < adjSize; ++a) {
2237         const PetscInt point = adj[a];
2238         if (pStart <= point && point < pEnd) {
2239           PetscInt *PETSC_RESTRICT pBuf;
2240           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2241           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2242           *pBuf = point;
2243         }
2244       }
2245       n++;
2246     }
2247     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2248     /* Derive CSR graph from section/segbuffer */
2249     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2250     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2251     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2252     for (idx = 0, p = pStart; p < pEnd; p++) {
2253       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2254       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2255     }
2256     xadj[n] = size;
2257     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2258     /* Clean up */
2259     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2260     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2261     ierr = PetscFree(adj);CHKERRQ(ierr);
2262     graph->xadj = xadj;
2263     graph->adjncy = adjncy;
2264   } else {
2265     Mat       A;
2266     PetscBool isseqaij, flg_row;
2267 
2268     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2269     if (!A->rmap->N || !A->cmap->N) {
2270       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2271       PetscFunctionReturn(0);
2272     }
2273     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2274     if (!isseqaij && filter) {
2275       PetscBool isseqdense;
2276 
2277       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2278       if (!isseqdense) {
2279         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2280       } else { /* TODO: rectangular case and LDA */
2281         PetscScalar *array;
2282         PetscReal   chop=1.e-6;
2283 
2284         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2285         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2286         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2287         for (i=0;i<n;i++) {
2288           PetscInt j;
2289           for (j=i+1;j<n;j++) {
2290             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2291             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2292             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2293           }
2294         }
2295         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2296         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2297       }
2298     } else {
2299       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2300       B = A;
2301     }
2302     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2303 
2304     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2305     if (filter) {
2306       PetscScalar *data;
2307       PetscInt    j,cum;
2308 
2309       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2310       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2311       cum = 0;
2312       for (i=0;i<n;i++) {
2313         PetscInt t;
2314 
2315         for (j=xadj[i];j<xadj[i+1];j++) {
2316           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2317             continue;
2318           }
2319           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2320         }
2321         t = xadj_filtered[i];
2322         xadj_filtered[i] = cum;
2323         cum += t;
2324       }
2325       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2326       graph->xadj = xadj_filtered;
2327       graph->adjncy = adjncy_filtered;
2328     } else {
2329       graph->xadj = xadj;
2330       graph->adjncy = adjncy;
2331     }
2332   }
2333   /* compute local connected components using PCBDDCGraph */
2334   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2335   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2336   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2337   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2338   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2339   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2340   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2341 
2342   /* partial clean up */
2343   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2344   if (B) {
2345     PetscBool flg_row;
2346     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2347     ierr = MatDestroy(&B);CHKERRQ(ierr);
2348   }
2349   if (isplex) {
2350     ierr = PetscFree(xadj);CHKERRQ(ierr);
2351     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2352   }
2353 
2354   /* get back data */
2355   if (isplex) {
2356     if (ncc) *ncc = graph->ncc;
2357     if (cc || primalv) {
2358       Mat          A;
2359       PetscBT      btv,btvt;
2360       PetscSection subSection;
2361       PetscInt     *ids,cum,cump,*cids,*pids;
2362 
2363       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2364       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2365       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2366       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2367       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2368 
2369       cids[0] = 0;
2370       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2371         PetscInt j;
2372 
2373         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2374         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2375           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2376 
2377           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2378           for (k = 0; k < 2*size; k += 2) {
2379             PetscInt s, pp, p = closure[k], off, dof, cdof;
2380 
2381             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2382             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2383             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2384             for (s = 0; s < dof-cdof; s++) {
2385               if (PetscBTLookupSet(btvt,off+s)) continue;
2386               if (!PetscBTLookup(btv,off+s)) {
2387                 ids[cum++] = off+s;
2388               } else { /* cross-vertex */
2389                 pids[cump++] = off+s;
2390               }
2391             }
2392             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2393             if (pp != p) {
2394               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2395               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2396               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2397               for (s = 0; s < dof-cdof; s++) {
2398                 if (PetscBTLookupSet(btvt,off+s)) continue;
2399                 if (!PetscBTLookup(btv,off+s)) {
2400                   ids[cum++] = off+s;
2401                 } else { /* cross-vertex */
2402                   pids[cump++] = off+s;
2403                 }
2404               }
2405             }
2406           }
2407           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2408         }
2409         cids[i+1] = cum;
2410         /* mark dofs as already assigned */
2411         for (j = cids[i]; j < cids[i+1]; j++) {
2412           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2413         }
2414       }
2415       if (cc) {
2416         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2417         for (i = 0; i < graph->ncc; i++) {
2418           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2419         }
2420         *cc = cc_n;
2421       }
2422       if (primalv) {
2423         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2424       }
2425       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2426       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2427       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2428     }
2429   } else {
2430     if (ncc) *ncc = graph->ncc;
2431     if (cc) {
2432       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2433       for (i=0;i<graph->ncc;i++) {
2434         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2435       }
2436       *cc = cc_n;
2437     }
2438   }
2439   /* clean up graph */
2440   graph->xadj = 0;
2441   graph->adjncy = 0;
2442   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2443   PetscFunctionReturn(0);
2444 }
2445 
2446 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2447 {
2448   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2449   PC_IS*         pcis = (PC_IS*)(pc->data);
2450   IS             dirIS = NULL;
2451   PetscInt       i;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2456   if (zerodiag) {
2457     Mat            A;
2458     Vec            vec3_N;
2459     PetscScalar    *vals;
2460     const PetscInt *idxs;
2461     PetscInt       nz,*count;
2462 
2463     /* p0 */
2464     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2465     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2466     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2467     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2468     for (i=0;i<nz;i++) vals[i] = 1.;
2469     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2470     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2471     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2472     /* v_I */
2473     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2474     for (i=0;i<nz;i++) vals[i] = 0.;
2475     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2476     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2477     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2478     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2479     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2480     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2481     if (dirIS) {
2482       PetscInt n;
2483 
2484       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2485       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2486       for (i=0;i<n;i++) vals[i] = 0.;
2487       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2488       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2489     }
2490     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2491     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2492     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2493     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2494     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2495     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2496     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2497     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2498     ierr = PetscFree(vals);CHKERRQ(ierr);
2499     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2500 
2501     /* there should not be any pressure dofs lying on the interface */
2502     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2503     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2504     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2505     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2506     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2507     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %D is an interface dof",idxs[i]);
2508     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2509     ierr = PetscFree(count);CHKERRQ(ierr);
2510   }
2511   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2512 
2513   /* check PCBDDCBenignGetOrSetP0 */
2514   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2515   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2516   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2517   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2518   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2519   for (i=0;i<pcbddc->benign_n;i++) {
2520     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2521     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2522   }
2523   PetscFunctionReturn(0);
2524 }
2525 
2526 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2527 {
2528   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2529   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2530   PetscInt       nz,n,benign_n,bsp = 1;
2531   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2532   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2533   PetscErrorCode ierr;
2534 
2535   PetscFunctionBegin;
2536   if (reuse) goto project_b0;
2537   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2538   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2539   for (n=0;n<pcbddc->benign_n;n++) {
2540     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2541   }
2542   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2543   has_null_pressures = PETSC_TRUE;
2544   have_null = PETSC_TRUE;
2545   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2546      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2547      Checks if all the pressure dofs in each subdomain have a zero diagonal
2548      If not, a change of basis on pressures is not needed
2549      since the local Schur complements are already SPD
2550   */
2551   if (pcbddc->n_ISForDofsLocal) {
2552     IS        iP = NULL;
2553     PetscInt  p,*pp;
2554     PetscBool flg;
2555 
2556     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2557     n    = pcbddc->n_ISForDofsLocal;
2558     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2559     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2560     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2561     if (!flg) {
2562       n = 1;
2563       pp[0] = pcbddc->n_ISForDofsLocal-1;
2564     }
2565 
2566     bsp = 0;
2567     for (p=0;p<n;p++) {
2568       PetscInt bs;
2569 
2570       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2571       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2572       bsp += bs;
2573     }
2574     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2575     bsp  = 0;
2576     for (p=0;p<n;p++) {
2577       const PetscInt *idxs;
2578       PetscInt       b,bs,npl,*bidxs;
2579 
2580       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2581       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2582       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2583       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2584       for (b=0;b<bs;b++) {
2585         PetscInt i;
2586 
2587         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2588         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2589         bsp++;
2590       }
2591       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2592       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2593     }
2594     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2595 
2596     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2597     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2598     if (iP) {
2599       IS newpressures;
2600 
2601       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2602       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2603       pressures = newpressures;
2604     }
2605     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2606     if (!sorted) {
2607       ierr = ISSort(pressures);CHKERRQ(ierr);
2608     }
2609     ierr = PetscFree(pp);CHKERRQ(ierr);
2610   }
2611 
2612   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2613   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2614   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2615   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2616   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2617   if (!sorted) {
2618     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2619   }
2620   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2621   zerodiag_save = zerodiag;
2622   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2623   if (!nz) {
2624     if (n) have_null = PETSC_FALSE;
2625     has_null_pressures = PETSC_FALSE;
2626     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2627   }
2628   recompute_zerodiag = PETSC_FALSE;
2629 
2630   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2631   zerodiag_subs    = NULL;
2632   benign_n         = 0;
2633   n_interior_dofs  = 0;
2634   interior_dofs    = NULL;
2635   nneu             = 0;
2636   if (pcbddc->NeumannBoundariesLocal) {
2637     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2638   }
2639   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2640   if (checkb) { /* need to compute interior nodes */
2641     PetscInt n,i,j;
2642     PetscInt n_neigh,*neigh,*n_shared,**shared;
2643     PetscInt *iwork;
2644 
2645     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2646     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2647     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2648     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2649     for (i=1;i<n_neigh;i++)
2650       for (j=0;j<n_shared[i];j++)
2651           iwork[shared[i][j]] += 1;
2652     for (i=0;i<n;i++)
2653       if (!iwork[i])
2654         interior_dofs[n_interior_dofs++] = i;
2655     ierr = PetscFree(iwork);CHKERRQ(ierr);
2656     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2657   }
2658   if (has_null_pressures) {
2659     IS             *subs;
2660     PetscInt       nsubs,i,j,nl;
2661     const PetscInt *idxs;
2662     PetscScalar    *array;
2663     Vec            *work;
2664     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2665 
2666     subs  = pcbddc->local_subs;
2667     nsubs = pcbddc->n_local_subs;
2668     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2669     if (checkb) {
2670       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2671       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2672       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2673       /* work[0] = 1_p */
2674       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2675       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2676       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2677       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2678       /* work[0] = 1_v */
2679       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2680       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2681       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2682       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2683       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2684     }
2685 
2686     if (nsubs > 1 || bsp > 1) {
2687       IS       *is;
2688       PetscInt b,totb;
2689 
2690       totb  = bsp;
2691       is    = bsp > 1 ? bzerodiag : &zerodiag;
2692       nsubs = PetscMax(nsubs,1);
2693       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2694       for (b=0;b<totb;b++) {
2695         for (i=0;i<nsubs;i++) {
2696           ISLocalToGlobalMapping l2g;
2697           IS                     t_zerodiag_subs;
2698           PetscInt               nl;
2699 
2700           if (subs) {
2701             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2702           } else {
2703             IS tis;
2704 
2705             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2706             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2707             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2708             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2709           }
2710           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2711           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2712           if (nl) {
2713             PetscBool valid = PETSC_TRUE;
2714 
2715             if (checkb) {
2716               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2717               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2718               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2719               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2720               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2721               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2722               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2723               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2724               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2725               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2726               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2727               for (j=0;j<n_interior_dofs;j++) {
2728                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2729                   valid = PETSC_FALSE;
2730                   break;
2731                 }
2732               }
2733               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2734             }
2735             if (valid && nneu) {
2736               const PetscInt *idxs;
2737               PetscInt       nzb;
2738 
2739               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2740               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2741               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2742               if (nzb) valid = PETSC_FALSE;
2743             }
2744             if (valid && pressures) {
2745               IS       t_pressure_subs,tmp;
2746               PetscInt i1,i2;
2747 
2748               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2749               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2750               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2751               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2752               if (i2 != i1) valid = PETSC_FALSE;
2753               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2754               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2755             }
2756             if (valid) {
2757               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2758               benign_n++;
2759             } else recompute_zerodiag = PETSC_TRUE;
2760           }
2761           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2762           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2763         }
2764       }
2765     } else { /* there's just one subdomain (or zero if they have not been detected */
2766       PetscBool valid = PETSC_TRUE;
2767 
2768       if (nneu) valid = PETSC_FALSE;
2769       if (valid && pressures) {
2770         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2771       }
2772       if (valid && checkb) {
2773         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2774         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2775         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2776         for (j=0;j<n_interior_dofs;j++) {
2777           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2778             valid = PETSC_FALSE;
2779             break;
2780           }
2781         }
2782         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2783       }
2784       if (valid) {
2785         benign_n = 1;
2786         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2787         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2788         zerodiag_subs[0] = zerodiag;
2789       }
2790     }
2791     if (checkb) {
2792       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2793     }
2794   }
2795   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2796 
2797   if (!benign_n) {
2798     PetscInt n;
2799 
2800     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2801     recompute_zerodiag = PETSC_FALSE;
2802     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2803     if (n) have_null = PETSC_FALSE;
2804   }
2805 
2806   /* final check for null pressures */
2807   if (zerodiag && pressures) {
2808     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2809   }
2810 
2811   if (recompute_zerodiag) {
2812     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2813     if (benign_n == 1) {
2814       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2815       zerodiag = zerodiag_subs[0];
2816     } else {
2817       PetscInt i,nzn,*new_idxs;
2818 
2819       nzn = 0;
2820       for (i=0;i<benign_n;i++) {
2821         PetscInt ns;
2822         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2823         nzn += ns;
2824       }
2825       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2826       nzn = 0;
2827       for (i=0;i<benign_n;i++) {
2828         PetscInt ns,*idxs;
2829         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2830         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2831         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2832         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2833         nzn += ns;
2834       }
2835       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2836       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2837     }
2838     have_null = PETSC_FALSE;
2839   }
2840 
2841   /* determines if the coarse solver will be singular or not */
2842   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2843 
2844   /* Prepare matrix to compute no-net-flux */
2845   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2846     Mat                    A,loc_divudotp;
2847     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2848     IS                     row,col,isused = NULL;
2849     PetscInt               M,N,n,st,n_isused;
2850 
2851     if (pressures) {
2852       isused = pressures;
2853     } else {
2854       isused = zerodiag_save;
2855     }
2856     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2857     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2858     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2859     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2860     n_isused = 0;
2861     if (isused) {
2862       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2863     }
2864     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2865     st = st-n_isused;
2866     if (n) {
2867       const PetscInt *gidxs;
2868 
2869       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2870       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2871       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2872       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2873       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2874       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2875     } else {
2876       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2877       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2878       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2879     }
2880     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2881     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2882     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2883     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2884     ierr = ISDestroy(&row);CHKERRQ(ierr);
2885     ierr = ISDestroy(&col);CHKERRQ(ierr);
2886     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2887     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2888     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2889     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2890     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2891     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2892     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2893     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2894     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2895     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2896   }
2897   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2898   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2899   if (bzerodiag) {
2900     PetscInt i;
2901 
2902     for (i=0;i<bsp;i++) {
2903       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2904     }
2905     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2906   }
2907   pcbddc->benign_n = benign_n;
2908   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2909 
2910   /* determines if the problem has subdomains with 0 pressure block */
2911   have_null = (PetscBool)(!!pcbddc->benign_n);
2912   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2913 
2914 project_b0:
2915   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2916   /* change of basis and p0 dofs */
2917   if (pcbddc->benign_n) {
2918     PetscInt i,s,*nnz;
2919 
2920     /* local change of basis for pressures */
2921     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2922     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2923     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2924     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2925     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2926     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2927     for (i=0;i<pcbddc->benign_n;i++) {
2928       const PetscInt *idxs;
2929       PetscInt       nzs,j;
2930 
2931       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2932       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2933       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2934       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2935       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2936     }
2937     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2938     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2939     ierr = PetscFree(nnz);CHKERRQ(ierr);
2940     /* set identity by default */
2941     for (i=0;i<n;i++) {
2942       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2943     }
2944     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2945     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2946     /* set change on pressures */
2947     for (s=0;s<pcbddc->benign_n;s++) {
2948       PetscScalar    *array;
2949       const PetscInt *idxs;
2950       PetscInt       nzs;
2951 
2952       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2953       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2954       for (i=0;i<nzs-1;i++) {
2955         PetscScalar vals[2];
2956         PetscInt    cols[2];
2957 
2958         cols[0] = idxs[i];
2959         cols[1] = idxs[nzs-1];
2960         vals[0] = 1.;
2961         vals[1] = 1.;
2962         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2963       }
2964       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2965       for (i=0;i<nzs-1;i++) array[i] = -1.;
2966       array[nzs-1] = 1.;
2967       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2968       /* store local idxs for p0 */
2969       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2970       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2971       ierr = PetscFree(array);CHKERRQ(ierr);
2972     }
2973     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2974     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975 
2976     /* project if needed */
2977     if (pcbddc->benign_change_explicit) {
2978       Mat M;
2979 
2980       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2981       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2982       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2983       ierr = MatDestroy(&M);CHKERRQ(ierr);
2984     }
2985     /* store global idxs for p0 */
2986     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2987   }
2988   *zerodiaglocal = zerodiag;
2989   PetscFunctionReturn(0);
2990 }
2991 
2992 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2993 {
2994   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2995   PetscScalar    *array;
2996   PetscErrorCode ierr;
2997 
2998   PetscFunctionBegin;
2999   if (!pcbddc->benign_sf) {
3000     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3001     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3002   }
3003   if (get) {
3004     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3005     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3006     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3007     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3008   } else {
3009     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3010     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3011     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3012     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3013   }
3014   PetscFunctionReturn(0);
3015 }
3016 
3017 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3018 {
3019   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3020   PetscErrorCode ierr;
3021 
3022   PetscFunctionBegin;
3023   /* TODO: add error checking
3024     - avoid nested pop (or push) calls.
3025     - cannot push before pop.
3026     - cannot call this if pcbddc->local_mat is NULL
3027   */
3028   if (!pcbddc->benign_n) {
3029     PetscFunctionReturn(0);
3030   }
3031   if (pop) {
3032     if (pcbddc->benign_change_explicit) {
3033       IS       is_p0;
3034       MatReuse reuse;
3035 
3036       /* extract B_0 */
3037       reuse = MAT_INITIAL_MATRIX;
3038       if (pcbddc->benign_B0) {
3039         reuse = MAT_REUSE_MATRIX;
3040       }
3041       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3042       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3043       /* remove rows and cols from local problem */
3044       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3045       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3046       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3047       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3048     } else {
3049       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3050       PetscScalar *vals;
3051       PetscInt    i,n,*idxs_ins;
3052 
3053       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3054       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3055       if (!pcbddc->benign_B0) {
3056         PetscInt *nnz;
3057         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3058         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3059         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3060         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3061         for (i=0;i<pcbddc->benign_n;i++) {
3062           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3063           nnz[i] = n - nnz[i];
3064         }
3065         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3066         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3067         ierr = PetscFree(nnz);CHKERRQ(ierr);
3068       }
3069 
3070       for (i=0;i<pcbddc->benign_n;i++) {
3071         PetscScalar *array;
3072         PetscInt    *idxs,j,nz,cum;
3073 
3074         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3075         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3076         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3077         for (j=0;j<nz;j++) vals[j] = 1.;
3078         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3079         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3080         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3081         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3082         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3083         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3084         cum = 0;
3085         for (j=0;j<n;j++) {
3086           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3087             vals[cum] = array[j];
3088             idxs_ins[cum] = j;
3089             cum++;
3090           }
3091         }
3092         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3093         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3094         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3095       }
3096       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3097       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3098       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3099     }
3100   } else { /* push */
3101     if (pcbddc->benign_change_explicit) {
3102       PetscInt i;
3103 
3104       for (i=0;i<pcbddc->benign_n;i++) {
3105         PetscScalar *B0_vals;
3106         PetscInt    *B0_cols,B0_ncol;
3107 
3108         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3109         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3110         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3111         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3112         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3113       }
3114       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3115       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3116     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3117   }
3118   PetscFunctionReturn(0);
3119 }
3120 
3121 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3122 {
3123   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3124   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3125   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3126   PetscBLASInt    *B_iwork,*B_ifail;
3127   PetscScalar     *work,lwork;
3128   PetscScalar     *St,*S,*eigv;
3129   PetscScalar     *Sarray,*Starray;
3130   PetscReal       *eigs,thresh,lthresh,uthresh;
3131   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3132   PetscBool       allocated_S_St;
3133 #if defined(PETSC_USE_COMPLEX)
3134   PetscReal       *rwork;
3135 #endif
3136   PetscErrorCode  ierr;
3137 
3138   PetscFunctionBegin;
3139   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3140   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3141   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3142   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3143 
3144   if (pcbddc->dbg_flag) {
3145     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3146     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3147     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3148     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3149   }
3150 
3151   if (pcbddc->dbg_flag) {
3152     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3153   }
3154 
3155   /* max size of subsets */
3156   mss = 0;
3157   for (i=0;i<sub_schurs->n_subs;i++) {
3158     PetscInt subset_size;
3159 
3160     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3161     mss = PetscMax(mss,subset_size);
3162   }
3163 
3164   /* min/max and threshold */
3165   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3166   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3167   nmax = PetscMax(nmin,nmax);
3168   allocated_S_St = PETSC_FALSE;
3169   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3170     allocated_S_St = PETSC_TRUE;
3171   }
3172 
3173   /* allocate lapack workspace */
3174   cum = cum2 = 0;
3175   maxneigs = 0;
3176   for (i=0;i<sub_schurs->n_subs;i++) {
3177     PetscInt n,subset_size;
3178 
3179     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3180     n = PetscMin(subset_size,nmax);
3181     cum += subset_size;
3182     cum2 += subset_size*n;
3183     maxneigs = PetscMax(maxneigs,n);
3184   }
3185   if (mss) {
3186     if (sub_schurs->is_symmetric) {
3187       PetscBLASInt B_itype = 1;
3188       PetscBLASInt B_N = mss;
3189       PetscReal    zero = 0.0;
3190       PetscReal    eps = 0.0; /* dlamch? */
3191 
3192       B_lwork = -1;
3193       S = NULL;
3194       St = NULL;
3195       eigs = NULL;
3196       eigv = NULL;
3197       B_iwork = NULL;
3198       B_ifail = NULL;
3199 #if defined(PETSC_USE_COMPLEX)
3200       rwork = NULL;
3201 #endif
3202       thresh = 1.0;
3203       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3204 #if defined(PETSC_USE_COMPLEX)
3205       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3206 #else
3207       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3208 #endif
3209       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3210       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3211     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3212   } else {
3213     lwork = 0;
3214   }
3215 
3216   nv = 0;
3217   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3218     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3219   }
3220   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3221   if (allocated_S_St) {
3222     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3223   }
3224   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3225 #if defined(PETSC_USE_COMPLEX)
3226   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3227 #endif
3228   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3229                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3230                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3231                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3232                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3233   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3234 
3235   maxneigs = 0;
3236   cum = cumarray = 0;
3237   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3238   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3239   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3240     const PetscInt *idxs;
3241 
3242     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3243     for (cum=0;cum<nv;cum++) {
3244       pcbddc->adaptive_constraints_n[cum] = 1;
3245       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3246       pcbddc->adaptive_constraints_data[cum] = 1.0;
3247       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3248       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3249     }
3250     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3251   }
3252 
3253   if (mss) { /* multilevel */
3254     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3255     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3256   }
3257 
3258   lthresh = pcbddc->adaptive_threshold[0];
3259   uthresh = pcbddc->adaptive_threshold[1];
3260   for (i=0;i<sub_schurs->n_subs;i++) {
3261     const PetscInt *idxs;
3262     PetscReal      upper,lower;
3263     PetscInt       j,subset_size,eigs_start = 0;
3264     PetscBLASInt   B_N;
3265     PetscBool      same_data = PETSC_FALSE;
3266     PetscBool      scal = PETSC_FALSE;
3267 
3268     if (pcbddc->use_deluxe_scaling) {
3269       upper = PETSC_MAX_REAL;
3270       lower = uthresh;
3271     } else {
3272       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3273       upper = 1./uthresh;
3274       lower = 0.;
3275     }
3276     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3277     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3278     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3279     /* this is experimental: we assume the dofs have been properly grouped to have
3280        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3281     if (!sub_schurs->is_posdef) {
3282       Mat T;
3283 
3284       for (j=0;j<subset_size;j++) {
3285         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3286           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3287           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3288           ierr = MatDestroy(&T);CHKERRQ(ierr);
3289           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3290           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3291           ierr = MatDestroy(&T);CHKERRQ(ierr);
3292           if (sub_schurs->change_primal_sub) {
3293             PetscInt       nz,k;
3294             const PetscInt *idxs;
3295 
3296             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3297             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3298             for (k=0;k<nz;k++) {
3299               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3300               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3301             }
3302             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3303           }
3304           scal = PETSC_TRUE;
3305           break;
3306         }
3307       }
3308     }
3309 
3310     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3311       if (sub_schurs->is_symmetric) {
3312         PetscInt j,k;
3313         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3314           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3315           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3316         }
3317         for (j=0;j<subset_size;j++) {
3318           for (k=j;k<subset_size;k++) {
3319             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3320             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3321           }
3322         }
3323       } else {
3324         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3325         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3326       }
3327     } else {
3328       S = Sarray + cumarray;
3329       St = Starray + cumarray;
3330     }
3331     /* see if we can save some work */
3332     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3333       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3334     }
3335 
3336     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3337       B_neigs = 0;
3338     } else {
3339       if (sub_schurs->is_symmetric) {
3340         PetscBLASInt B_itype = 1;
3341         PetscBLASInt B_IL, B_IU;
3342         PetscReal    eps = -1.0; /* dlamch? */
3343         PetscInt     nmin_s;
3344         PetscBool    compute_range;
3345 
3346         B_neigs = 0;
3347         compute_range = (PetscBool)!same_data;
3348         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3349 
3350         if (pcbddc->dbg_flag) {
3351           PetscInt nc = 0;
3352 
3353           if (sub_schurs->change_primal_sub) {
3354             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3355           }
3356           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3357         }
3358 
3359         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3360         if (compute_range) {
3361 
3362           /* ask for eigenvalues larger than thresh */
3363           if (sub_schurs->is_posdef) {
3364 #if defined(PETSC_USE_COMPLEX)
3365             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3366 #else
3367             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3368 #endif
3369             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3370           } else { /* no theory so far, but it works nicely */
3371             PetscInt  recipe = 0,recipe_m = 1;
3372             PetscReal bb[2];
3373 
3374             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3375             switch (recipe) {
3376             case 0:
3377               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3378               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3379 #if defined(PETSC_USE_COMPLEX)
3380               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3381 #else
3382               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3383 #endif
3384               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3385               break;
3386             case 1:
3387               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3388 #if defined(PETSC_USE_COMPLEX)
3389               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3390 #else
3391               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3392 #endif
3393               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3394               if (!scal) {
3395                 PetscBLASInt B_neigs2 = 0;
3396 
3397                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3398                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3399                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3400 #if defined(PETSC_USE_COMPLEX)
3401                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3402 #else
3403                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3404 #endif
3405                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3406                 B_neigs += B_neigs2;
3407               }
3408               break;
3409             case 2:
3410               if (scal) {
3411                 bb[0] = PETSC_MIN_REAL;
3412                 bb[1] = 0;
3413 #if defined(PETSC_USE_COMPLEX)
3414                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3415 #else
3416                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3417 #endif
3418                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3419               } else {
3420                 PetscBLASInt B_neigs2 = 0;
3421                 PetscBool    import = PETSC_FALSE;
3422 
3423                 lthresh = PetscMax(lthresh,0.0);
3424                 if (lthresh > 0.0) {
3425                   bb[0] = PETSC_MIN_REAL;
3426                   bb[1] = lthresh*lthresh;
3427 
3428                   import = PETSC_TRUE;
3429 #if defined(PETSC_USE_COMPLEX)
3430                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3431 #else
3432                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3433 #endif
3434                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3435                 }
3436                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3437                 bb[1] = PETSC_MAX_REAL;
3438                 if (import) {
3439                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3440                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3441                 }
3442 #if defined(PETSC_USE_COMPLEX)
3443                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3444 #else
3445                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3446 #endif
3447                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3448                 B_neigs += B_neigs2;
3449               }
3450               break;
3451             case 3:
3452               if (scal) {
3453                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3454               } else {
3455                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3456               }
3457               if (!scal) {
3458                 bb[0] = uthresh;
3459                 bb[1] = PETSC_MAX_REAL;
3460 #if defined(PETSC_USE_COMPLEX)
3461                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3462 #else
3463                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3464 #endif
3465                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3466               }
3467               if (recipe_m > 0 && B_N - B_neigs > 0) {
3468                 PetscBLASInt B_neigs2 = 0;
3469 
3470                 B_IL = 1;
3471                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3472                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3473                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3474 #if defined(PETSC_USE_COMPLEX)
3475                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3476 #else
3477                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3478 #endif
3479                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3480                 B_neigs += B_neigs2;
3481               }
3482               break;
3483             case 4:
3484               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3485 #if defined(PETSC_USE_COMPLEX)
3486               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3487 #else
3488               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3489 #endif
3490               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3491               {
3492                 PetscBLASInt B_neigs2 = 0;
3493 
3494                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3495                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3496                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3497 #if defined(PETSC_USE_COMPLEX)
3498                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3499 #else
3500                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3501 #endif
3502                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3503                 B_neigs += B_neigs2;
3504               }
3505               break;
3506             case 5: /* same as before: first compute all eigenvalues, then filter */
3507 #if defined(PETSC_USE_COMPLEX)
3508               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3509 #else
3510               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3511 #endif
3512               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3513               {
3514                 PetscInt e,k,ne;
3515                 for (e=0,ne=0;e<B_neigs;e++) {
3516                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3517                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3518                     eigs[ne] = eigs[e];
3519                     ne++;
3520                   }
3521                 }
3522                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3523                 B_neigs = ne;
3524               }
3525               break;
3526             default:
3527               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3528               break;
3529             }
3530           }
3531         } else if (!same_data) { /* this is just to see all the eigenvalues */
3532           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3533           B_IL = 1;
3534 #if defined(PETSC_USE_COMPLEX)
3535           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3536 #else
3537           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3538 #endif
3539           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3540         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3541           PetscInt k;
3542           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3543           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3544           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3545           nmin = nmax;
3546           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3547           for (k=0;k<nmax;k++) {
3548             eigs[k] = 1./PETSC_SMALL;
3549             eigv[k*(subset_size+1)] = 1.0;
3550           }
3551         }
3552         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3553         if (B_ierr) {
3554           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3555           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3556           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3557         }
3558 
3559         if (B_neigs > nmax) {
3560           if (pcbddc->dbg_flag) {
3561             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3562           }
3563           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3564           B_neigs = nmax;
3565         }
3566 
3567         nmin_s = PetscMin(nmin,B_N);
3568         if (B_neigs < nmin_s) {
3569           PetscBLASInt B_neigs2 = 0;
3570 
3571           if (pcbddc->use_deluxe_scaling) {
3572             if (scal) {
3573               B_IU = nmin_s;
3574               B_IL = B_neigs + 1;
3575             } else {
3576               B_IL = B_N - nmin_s + 1;
3577               B_IU = B_N - B_neigs;
3578             }
3579           } else {
3580             B_IL = B_neigs + 1;
3581             B_IU = nmin_s;
3582           }
3583           if (pcbddc->dbg_flag) {
3584             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %D. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);CHKERRQ(ierr);
3585           }
3586           if (sub_schurs->is_symmetric) {
3587             PetscInt j,k;
3588             for (j=0;j<subset_size;j++) {
3589               for (k=j;k<subset_size;k++) {
3590                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3591                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3592               }
3593             }
3594           } else {
3595             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3596             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3597           }
3598           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3599 #if defined(PETSC_USE_COMPLEX)
3600           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3601 #else
3602           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3603 #endif
3604           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3605           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3606           B_neigs += B_neigs2;
3607         }
3608         if (B_ierr) {
3609           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3610           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3611           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3612         }
3613         if (pcbddc->dbg_flag) {
3614           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3615           for (j=0;j<B_neigs;j++) {
3616             if (eigs[j] == 0.0) {
3617               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3618             } else {
3619               if (pcbddc->use_deluxe_scaling) {
3620                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3621               } else {
3622                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3623               }
3624             }
3625           }
3626         }
3627       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3628     }
3629     /* change the basis back to the original one */
3630     if (sub_schurs->change) {
3631       Mat change,phi,phit;
3632 
3633       if (pcbddc->dbg_flag > 2) {
3634         PetscInt ii;
3635         for (ii=0;ii<B_neigs;ii++) {
3636           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3637           for (j=0;j<B_N;j++) {
3638 #if defined(PETSC_USE_COMPLEX)
3639             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3640             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3641             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3642 #else
3643             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3644 #endif
3645           }
3646         }
3647       }
3648       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3649       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3650       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3651       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3652       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3653       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3654     }
3655     maxneigs = PetscMax(B_neigs,maxneigs);
3656     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3657     if (B_neigs) {
3658       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3659 
3660       if (pcbddc->dbg_flag > 1) {
3661         PetscInt ii;
3662         for (ii=0;ii<B_neigs;ii++) {
3663           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3664           for (j=0;j<B_N;j++) {
3665 #if defined(PETSC_USE_COMPLEX)
3666             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3667             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3668             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3669 #else
3670             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3671 #endif
3672           }
3673         }
3674       }
3675       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3676       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3677       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3678       cum++;
3679     }
3680     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3681     /* shift for next computation */
3682     cumarray += subset_size*subset_size;
3683   }
3684   if (pcbddc->dbg_flag) {
3685     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3686   }
3687 
3688   if (mss) {
3689     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3690     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3691     /* destroy matrices (junk) */
3692     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3693     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3694   }
3695   if (allocated_S_St) {
3696     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3697   }
3698   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3699 #if defined(PETSC_USE_COMPLEX)
3700   ierr = PetscFree(rwork);CHKERRQ(ierr);
3701 #endif
3702   if (pcbddc->dbg_flag) {
3703     PetscInt maxneigs_r;
3704     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3705     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3706   }
3707   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3708   PetscFunctionReturn(0);
3709 }
3710 
3711 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3712 {
3713   PetscScalar    *coarse_submat_vals;
3714   PetscErrorCode ierr;
3715 
3716   PetscFunctionBegin;
3717   /* Setup local scatters R_to_B and (optionally) R_to_D */
3718   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3719   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3720 
3721   /* Setup local neumann solver ksp_R */
3722   /* PCBDDCSetUpLocalScatters should be called first! */
3723   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3724 
3725   /*
3726      Setup local correction and local part of coarse basis.
3727      Gives back the dense local part of the coarse matrix in column major ordering
3728   */
3729   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3730 
3731   /* Compute total number of coarse nodes and setup coarse solver */
3732   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3733 
3734   /* free */
3735   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3736   PetscFunctionReturn(0);
3737 }
3738 
3739 PetscErrorCode PCBDDCResetCustomization(PC pc)
3740 {
3741   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3742   PetscErrorCode ierr;
3743 
3744   PetscFunctionBegin;
3745   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3746   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3747   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3748   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3749   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3750   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3751   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3753   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3754   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3755   PetscFunctionReturn(0);
3756 }
3757 
3758 PetscErrorCode PCBDDCResetTopography(PC pc)
3759 {
3760   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3761   PetscInt       i;
3762   PetscErrorCode ierr;
3763 
3764   PetscFunctionBegin;
3765   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3766   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3767   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3768   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3769   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3770   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3771   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3772   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3773   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3774   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3775   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3776   for (i=0;i<pcbddc->n_local_subs;i++) {
3777     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3778   }
3779   pcbddc->n_local_subs = 0;
3780   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3781   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3782   pcbddc->graphanalyzed        = PETSC_FALSE;
3783   pcbddc->recompute_topography = PETSC_TRUE;
3784   pcbddc->corner_selected      = PETSC_FALSE;
3785   PetscFunctionReturn(0);
3786 }
3787 
3788 PetscErrorCode PCBDDCResetSolvers(PC pc)
3789 {
3790   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3791   PetscErrorCode ierr;
3792 
3793   PetscFunctionBegin;
3794   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3795   if (pcbddc->coarse_phi_B) {
3796     PetscScalar *array;
3797     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3798     ierr = PetscFree(array);CHKERRQ(ierr);
3799   }
3800   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3801   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3802   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3803   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3804   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3805   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3806   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3807   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3809   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3810   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3811   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3812   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3813   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3814   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3815   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3816   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3817   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3818   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3819   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3820   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3821   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3822   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3823   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3824   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3825   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3826   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3827   if (pcbddc->benign_zerodiag_subs) {
3828     PetscInt i;
3829     for (i=0;i<pcbddc->benign_n;i++) {
3830       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3831     }
3832     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3833   }
3834   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3835   PetscFunctionReturn(0);
3836 }
3837 
3838 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3839 {
3840   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3841   PC_IS          *pcis = (PC_IS*)pc->data;
3842   VecType        impVecType;
3843   PetscInt       n_constraints,n_R,old_size;
3844   PetscErrorCode ierr;
3845 
3846   PetscFunctionBegin;
3847   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3848   n_R = pcis->n - pcbddc->n_vertices;
3849   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3850   /* local work vectors (try to avoid unneeded work)*/
3851   /* R nodes */
3852   old_size = -1;
3853   if (pcbddc->vec1_R) {
3854     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3855   }
3856   if (n_R != old_size) {
3857     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3858     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3859     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3860     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3861     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3862     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3863   }
3864   /* local primal dofs */
3865   old_size = -1;
3866   if (pcbddc->vec1_P) {
3867     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3868   }
3869   if (pcbddc->local_primal_size != old_size) {
3870     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3871     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3872     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3873     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3874   }
3875   /* local explicit constraints */
3876   old_size = -1;
3877   if (pcbddc->vec1_C) {
3878     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3879   }
3880   if (n_constraints && n_constraints != old_size) {
3881     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3882     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3883     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3884     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3885   }
3886   PetscFunctionReturn(0);
3887 }
3888 
3889 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3890 {
3891   PetscErrorCode  ierr;
3892   /* pointers to pcis and pcbddc */
3893   PC_IS*          pcis = (PC_IS*)pc->data;
3894   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3895   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3896   /* submatrices of local problem */
3897   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3898   /* submatrices of local coarse problem */
3899   Mat             S_VV,S_CV,S_VC,S_CC;
3900   /* working matrices */
3901   Mat             C_CR;
3902   /* additional working stuff */
3903   PC              pc_R;
3904   Mat             F,Brhs = NULL;
3905   Vec             dummy_vec;
3906   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3907   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3908   PetscScalar     *work;
3909   PetscInt        *idx_V_B;
3910   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3911   PetscInt        i,n_R,n_D,n_B;
3912   PetscScalar     one=1.0,m_one=-1.0;
3913 
3914   PetscFunctionBegin;
3915   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3916   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3917 
3918   /* Set Non-overlapping dimensions */
3919   n_vertices = pcbddc->n_vertices;
3920   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3921   n_B = pcis->n_B;
3922   n_D = pcis->n - n_B;
3923   n_R = pcis->n - n_vertices;
3924 
3925   /* vertices in boundary numbering */
3926   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3927   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3928   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3929 
3930   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3931   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3932   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3933   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3934   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3935   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3936   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3937   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3938   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3939   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3940 
3941   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3942   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3943   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3944   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3945   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3946   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3947   lda_rhs = n_R;
3948   need_benign_correction = PETSC_FALSE;
3949   if (isLU || isILU || isCHOL) {
3950     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3951   } else if (sub_schurs && sub_schurs->reuse_solver) {
3952     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3953     MatFactorType      type;
3954 
3955     F = reuse_solver->F;
3956     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3957     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3958     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3959     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3960   } else {
3961     F = NULL;
3962   }
3963 
3964   /* determine if we can use a sparse right-hand side */
3965   sparserhs = PETSC_FALSE;
3966   if (F) {
3967     MatSolverType solver;
3968 
3969     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3970     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3971   }
3972 
3973   /* allocate workspace */
3974   n = 0;
3975   if (n_constraints) {
3976     n += lda_rhs*n_constraints;
3977   }
3978   if (n_vertices) {
3979     n = PetscMax(2*lda_rhs*n_vertices,n);
3980     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3981   }
3982   if (!pcbddc->symmetric_primal) {
3983     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3984   }
3985   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3986 
3987   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3988   dummy_vec = NULL;
3989   if (need_benign_correction && lda_rhs != n_R && F) {
3990     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3991     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3992     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3993   }
3994 
3995   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3996   if (n_constraints) {
3997     Mat         M3,C_B;
3998     IS          is_aux;
3999     PetscScalar *array,*array2;
4000 
4001     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4002     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4003 
4004     /* Extract constraints on R nodes: C_{CR}  */
4005     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4006     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4007     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4008 
4009     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4010     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4011     if (!sparserhs) {
4012       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4013       for (i=0;i<n_constraints;i++) {
4014         const PetscScalar *row_cmat_values;
4015         const PetscInt    *row_cmat_indices;
4016         PetscInt          size_of_constraint,j;
4017 
4018         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4019         for (j=0;j<size_of_constraint;j++) {
4020           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4021         }
4022         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4023       }
4024       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4025     } else {
4026       Mat tC_CR;
4027 
4028       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4029       if (lda_rhs != n_R) {
4030         PetscScalar *aa;
4031         PetscInt    r,*ii,*jj;
4032         PetscBool   done;
4033 
4034         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4035         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4036         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4037         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4038         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4039         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4040       } else {
4041         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4042         tC_CR = C_CR;
4043       }
4044       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4045       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4046     }
4047     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4048     if (F) {
4049       if (need_benign_correction) {
4050         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4051 
4052         /* rhs is already zero on interior dofs, no need to change the rhs */
4053         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4054       }
4055       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4056       if (need_benign_correction) {
4057         PetscScalar        *marr;
4058         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4059 
4060         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4061         if (lda_rhs != n_R) {
4062           for (i=0;i<n_constraints;i++) {
4063             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4064             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4065             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4066           }
4067         } else {
4068           for (i=0;i<n_constraints;i++) {
4069             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4070             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4071             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4072           }
4073         }
4074         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4075       }
4076     } else {
4077       PetscScalar *marr;
4078 
4079       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4080       for (i=0;i<n_constraints;i++) {
4081         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4082         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4083         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4084         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4085         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4086         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4087       }
4088       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4089     }
4090     if (sparserhs) {
4091       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4092     }
4093     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4094     if (!pcbddc->switch_static) {
4095       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4096       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4097       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4098       for (i=0;i<n_constraints;i++) {
4099         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4100         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4101         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4102         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4103         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4104         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4105       }
4106       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4107       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4108       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4109     } else {
4110       if (lda_rhs != n_R) {
4111         IS dummy;
4112 
4113         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4114         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4115         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4116       } else {
4117         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4118         pcbddc->local_auxmat2 = local_auxmat2_R;
4119       }
4120       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4121     }
4122     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4123     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4124     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4125     if (isCHOL) {
4126       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4127     } else {
4128       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4129     }
4130     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4131     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4132     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4133     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4134     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4135     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4136   }
4137 
4138   /* Get submatrices from subdomain matrix */
4139   if (n_vertices) {
4140     IS        is_aux;
4141     PetscBool isseqaij;
4142 
4143     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4144       IS tis;
4145 
4146       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4147       ierr = ISSort(tis);CHKERRQ(ierr);
4148       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4149       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4150     } else {
4151       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4152     }
4153     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4154     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4155     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4156     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4157       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4158     }
4159     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4160     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4161   }
4162 
4163   /* Matrix of coarse basis functions (local) */
4164   if (pcbddc->coarse_phi_B) {
4165     PetscInt on_B,on_primal,on_D=n_D;
4166     if (pcbddc->coarse_phi_D) {
4167       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4168     }
4169     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4170     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4171       PetscScalar *marray;
4172 
4173       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4174       ierr = PetscFree(marray);CHKERRQ(ierr);
4175       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4176       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4177       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4178       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4179     }
4180   }
4181 
4182   if (!pcbddc->coarse_phi_B) {
4183     PetscScalar *marr;
4184 
4185     /* memory size */
4186     n = n_B*pcbddc->local_primal_size;
4187     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4188     if (!pcbddc->symmetric_primal) n *= 2;
4189     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4190     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4191     marr += n_B*pcbddc->local_primal_size;
4192     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4193       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4194       marr += n_D*pcbddc->local_primal_size;
4195     }
4196     if (!pcbddc->symmetric_primal) {
4197       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4198       marr += n_B*pcbddc->local_primal_size;
4199       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4200         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4201       }
4202     } else {
4203       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4204       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4205       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4206         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4207         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4208       }
4209     }
4210   }
4211 
4212   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4213   p0_lidx_I = NULL;
4214   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4215     const PetscInt *idxs;
4216 
4217     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4218     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4219     for (i=0;i<pcbddc->benign_n;i++) {
4220       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4221     }
4222     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4223   }
4224 
4225   /* vertices */
4226   if (n_vertices) {
4227     PetscBool restoreavr = PETSC_FALSE;
4228 
4229     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4230 
4231     if (n_R) {
4232       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4233       PetscBLASInt      B_N,B_one = 1;
4234       const PetscScalar *x;
4235       PetscScalar       *y;
4236 
4237       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4238       if (need_benign_correction) {
4239         ISLocalToGlobalMapping RtoN;
4240         IS                     is_p0;
4241         PetscInt               *idxs_p0,n;
4242 
4243         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4244         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4245         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4246         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n);
4247         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4248         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4249         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4250         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4251       }
4252 
4253       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4254       if (!sparserhs || need_benign_correction) {
4255         if (lda_rhs == n_R) {
4256           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4257         } else {
4258           PetscScalar    *av,*array;
4259           const PetscInt *xadj,*adjncy;
4260           PetscInt       n;
4261           PetscBool      flg_row;
4262 
4263           array = work+lda_rhs*n_vertices;
4264           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4265           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4266           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4267           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4268           for (i=0;i<n;i++) {
4269             PetscInt j;
4270             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4271           }
4272           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4273           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4274           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4275         }
4276         if (need_benign_correction) {
4277           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4278           PetscScalar        *marr;
4279 
4280           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4281           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4282 
4283                  | 0 0  0 | (V)
4284              L = | 0 0 -1 | (P-p0)
4285                  | 0 0 -1 | (p0)
4286 
4287           */
4288           for (i=0;i<reuse_solver->benign_n;i++) {
4289             const PetscScalar *vals;
4290             const PetscInt    *idxs,*idxs_zero;
4291             PetscInt          n,j,nz;
4292 
4293             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4294             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4295             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4296             for (j=0;j<n;j++) {
4297               PetscScalar val = vals[j];
4298               PetscInt    k,col = idxs[j];
4299               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4300             }
4301             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4302             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4303           }
4304           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4305         }
4306         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4307         Brhs = A_RV;
4308       } else {
4309         Mat tA_RVT,A_RVT;
4310 
4311         if (!pcbddc->symmetric_primal) {
4312           /* A_RV already scaled by -1 */
4313           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4314         } else {
4315           restoreavr = PETSC_TRUE;
4316           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4317           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4318           A_RVT = A_VR;
4319         }
4320         if (lda_rhs != n_R) {
4321           PetscScalar *aa;
4322           PetscInt    r,*ii,*jj;
4323           PetscBool   done;
4324 
4325           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4326           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4327           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4328           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4329           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4330           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4331         } else {
4332           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4333           tA_RVT = A_RVT;
4334         }
4335         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4336         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4337         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4338       }
4339       if (F) {
4340         /* need to correct the rhs */
4341         if (need_benign_correction) {
4342           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4343           PetscScalar        *marr;
4344 
4345           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4346           if (lda_rhs != n_R) {
4347             for (i=0;i<n_vertices;i++) {
4348               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4349               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4350               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4351             }
4352           } else {
4353             for (i=0;i<n_vertices;i++) {
4354               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4355               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4356               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4357             }
4358           }
4359           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4360         }
4361         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4362         if (restoreavr) {
4363           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4364         }
4365         /* need to correct the solution */
4366         if (need_benign_correction) {
4367           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4368           PetscScalar        *marr;
4369 
4370           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4371           if (lda_rhs != n_R) {
4372             for (i=0;i<n_vertices;i++) {
4373               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4374               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4375               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4376             }
4377           } else {
4378             for (i=0;i<n_vertices;i++) {
4379               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4380               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4381               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4382             }
4383           }
4384           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4385         }
4386       } else {
4387         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4388         for (i=0;i<n_vertices;i++) {
4389           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4390           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4391           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4392           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4393           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4394           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4395         }
4396         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4397       }
4398       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4399       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4400       /* S_VV and S_CV */
4401       if (n_constraints) {
4402         Mat B;
4403 
4404         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4405         for (i=0;i<n_vertices;i++) {
4406           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4407           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4408           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4409           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4410           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4411           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4412         }
4413         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4414         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4415         ierr = MatDestroy(&B);CHKERRQ(ierr);
4416         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4417         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4418         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4419         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4420         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4421         ierr = MatDestroy(&B);CHKERRQ(ierr);
4422       }
4423       if (lda_rhs != n_R) {
4424         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4425         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4426         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4427       }
4428       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4429       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4430       if (need_benign_correction) {
4431         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4432         PetscScalar      *marr,*sums;
4433 
4434         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4435         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4436         for (i=0;i<reuse_solver->benign_n;i++) {
4437           const PetscScalar *vals;
4438           const PetscInt    *idxs,*idxs_zero;
4439           PetscInt          n,j,nz;
4440 
4441           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4442           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4443           for (j=0;j<n_vertices;j++) {
4444             PetscInt k;
4445             sums[j] = 0.;
4446             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4447           }
4448           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4449           for (j=0;j<n;j++) {
4450             PetscScalar val = vals[j];
4451             PetscInt k;
4452             for (k=0;k<n_vertices;k++) {
4453               marr[idxs[j]+k*n_vertices] += val*sums[k];
4454             }
4455           }
4456           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4457           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4458         }
4459         ierr = PetscFree(sums);CHKERRQ(ierr);
4460         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4461         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4462       }
4463       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4464       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4465       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4466       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4467       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4468       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4469       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4470       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4471       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4472     } else {
4473       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4474     }
4475     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4476 
4477     /* coarse basis functions */
4478     for (i=0;i<n_vertices;i++) {
4479       PetscScalar *y;
4480 
4481       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4482       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4483       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4484       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4485       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4486       y[n_B*i+idx_V_B[i]] = 1.0;
4487       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4488       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4489 
4490       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4491         PetscInt j;
4492 
4493         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4494         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4495         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4496         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4497         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4498         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4499         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4500       }
4501       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4502     }
4503     /* if n_R == 0 the object is not destroyed */
4504     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4505   }
4506   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4507 
4508   if (n_constraints) {
4509     Mat B;
4510 
4511     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4512     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4513     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4514     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4515     if (n_vertices) {
4516       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4517         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4518       } else {
4519         Mat S_VCt;
4520 
4521         if (lda_rhs != n_R) {
4522           ierr = MatDestroy(&B);CHKERRQ(ierr);
4523           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4524           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4525         }
4526         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4527         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4528         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4529       }
4530     }
4531     ierr = MatDestroy(&B);CHKERRQ(ierr);
4532     /* coarse basis functions */
4533     for (i=0;i<n_constraints;i++) {
4534       PetscScalar *y;
4535 
4536       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4537       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4538       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4539       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4540       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4541       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4542       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4543       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4544         PetscInt j;
4545 
4546         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4547         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4548         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4549         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4550         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4551         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4552         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4553       }
4554       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4555     }
4556   }
4557   if (n_constraints) {
4558     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4559   }
4560   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4561 
4562   /* coarse matrix entries relative to B_0 */
4563   if (pcbddc->benign_n) {
4564     Mat               B0_B,B0_BPHI;
4565     IS                is_dummy;
4566     const PetscScalar *data;
4567     PetscInt          j;
4568 
4569     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4570     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4571     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4572     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4573     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4574     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4575     for (j=0;j<pcbddc->benign_n;j++) {
4576       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4577       for (i=0;i<pcbddc->local_primal_size;i++) {
4578         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4579         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4580       }
4581     }
4582     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4583     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4584     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4585   }
4586 
4587   /* compute other basis functions for non-symmetric problems */
4588   if (!pcbddc->symmetric_primal) {
4589     Mat         B_V=NULL,B_C=NULL;
4590     PetscScalar *marray;
4591 
4592     if (n_constraints) {
4593       Mat S_CCT,C_CRT;
4594 
4595       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4596       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4597       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4598       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4599       if (n_vertices) {
4600         Mat S_VCT;
4601 
4602         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4603         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4604         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4605       }
4606       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4607     } else {
4608       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4609     }
4610     if (n_vertices && n_R) {
4611       PetscScalar    *av,*marray;
4612       const PetscInt *xadj,*adjncy;
4613       PetscInt       n;
4614       PetscBool      flg_row;
4615 
4616       /* B_V = B_V - A_VR^T */
4617       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4618       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4619       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4620       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4621       for (i=0;i<n;i++) {
4622         PetscInt j;
4623         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4624       }
4625       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4626       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4627       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4628     }
4629 
4630     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4631     if (n_vertices) {
4632       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4633       for (i=0;i<n_vertices;i++) {
4634         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4635         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4636         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4637         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4638         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4639         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4640       }
4641       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4642     }
4643     if (B_C) {
4644       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4645       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4646         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4647         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4648         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4649         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4650         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4651         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4652       }
4653       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4654     }
4655     /* coarse basis functions */
4656     for (i=0;i<pcbddc->local_primal_size;i++) {
4657       PetscScalar *y;
4658 
4659       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4660       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4661       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4662       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4663       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4664       if (i<n_vertices) {
4665         y[n_B*i+idx_V_B[i]] = 1.0;
4666       }
4667       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4668       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4669 
4670       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4671         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4672         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4673         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4674         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4675         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4676         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4677       }
4678       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4679     }
4680     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4681     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4682   }
4683 
4684   /* free memory */
4685   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4686   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4687   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4688   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4689   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4690   ierr = PetscFree(work);CHKERRQ(ierr);
4691   if (n_vertices) {
4692     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4693   }
4694   if (n_constraints) {
4695     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4696   }
4697   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4698 
4699   /* Checking coarse_sub_mat and coarse basis functios */
4700   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4701   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4702   if (pcbddc->dbg_flag) {
4703     Mat         coarse_sub_mat;
4704     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4705     Mat         coarse_phi_D,coarse_phi_B;
4706     Mat         coarse_psi_D,coarse_psi_B;
4707     Mat         A_II,A_BB,A_IB,A_BI;
4708     Mat         C_B,CPHI;
4709     IS          is_dummy;
4710     Vec         mones;
4711     MatType     checkmattype=MATSEQAIJ;
4712     PetscReal   real_value;
4713 
4714     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4715       Mat A;
4716       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4717       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4718       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4719       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4720       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4721       ierr = MatDestroy(&A);CHKERRQ(ierr);
4722     } else {
4723       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4724       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4725       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4726       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4727     }
4728     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4729     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4730     if (!pcbddc->symmetric_primal) {
4731       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4732       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4733     }
4734     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4735 
4736     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4737     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4738     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4739     if (!pcbddc->symmetric_primal) {
4740       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4741       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4742       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4743       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4744       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4745       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4746       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4747       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4748       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4749       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4750       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4751       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4752     } else {
4753       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4754       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4755       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4756       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4757       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4758       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4759       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4760       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4761     }
4762     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4763     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4764     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4765     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4766     if (pcbddc->benign_n) {
4767       Mat               B0_B,B0_BPHI;
4768       const PetscScalar *data2;
4769       PetscScalar       *data;
4770       PetscInt          j;
4771 
4772       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4773       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4774       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4775       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4776       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4777       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4778       for (j=0;j<pcbddc->benign_n;j++) {
4779         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4780         for (i=0;i<pcbddc->local_primal_size;i++) {
4781           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4782           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4783         }
4784       }
4785       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4786       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4787       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4788       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4789       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4790     }
4791 #if 0
4792   {
4793     PetscViewer viewer;
4794     char filename[256];
4795     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4796     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4797     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4798     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4799     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4800     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4801     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4802     if (pcbddc->coarse_phi_B) {
4803       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4804       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4805     }
4806     if (pcbddc->coarse_phi_D) {
4807       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4808       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4809     }
4810     if (pcbddc->coarse_psi_B) {
4811       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4812       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4813     }
4814     if (pcbddc->coarse_psi_D) {
4815       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4816       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4817     }
4818     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4819     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4820     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4821     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4822     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4823     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4824     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4825     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4826     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4827     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4828     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4829   }
4830 #endif
4831     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4832     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4833     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4834     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4835 
4836     /* check constraints */
4837     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4838     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4839     if (!pcbddc->benign_n) { /* TODO: add benign case */
4840       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4841     } else {
4842       PetscScalar *data;
4843       Mat         tmat;
4844       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4845       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4846       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4847       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4848       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4849     }
4850     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4851     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4852     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4853     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4854     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4855     if (!pcbddc->symmetric_primal) {
4856       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4857       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4858       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4859       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4860       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4861     }
4862     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4863     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4864     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4865     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4866     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4867     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4868     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4869     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4870     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4871     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4872     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4873     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4874     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4875     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4876     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4877     if (!pcbddc->symmetric_primal) {
4878       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4879       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4880     }
4881     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4882   }
4883   /* get back data */
4884   *coarse_submat_vals_n = coarse_submat_vals;
4885   PetscFunctionReturn(0);
4886 }
4887 
4888 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4889 {
4890   Mat            *work_mat;
4891   IS             isrow_s,iscol_s;
4892   PetscBool      rsorted,csorted;
4893   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4894   PetscErrorCode ierr;
4895 
4896   PetscFunctionBegin;
4897   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4898   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4899   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4900   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4901 
4902   if (!rsorted) {
4903     const PetscInt *idxs;
4904     PetscInt *idxs_sorted,i;
4905 
4906     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4907     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4908     for (i=0;i<rsize;i++) {
4909       idxs_perm_r[i] = i;
4910     }
4911     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4912     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4913     for (i=0;i<rsize;i++) {
4914       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4915     }
4916     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4917     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4918   } else {
4919     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4920     isrow_s = isrow;
4921   }
4922 
4923   if (!csorted) {
4924     if (isrow == iscol) {
4925       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4926       iscol_s = isrow_s;
4927     } else {
4928       const PetscInt *idxs;
4929       PetscInt       *idxs_sorted,i;
4930 
4931       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4932       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4933       for (i=0;i<csize;i++) {
4934         idxs_perm_c[i] = i;
4935       }
4936       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4937       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4938       for (i=0;i<csize;i++) {
4939         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4940       }
4941       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4942       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4943     }
4944   } else {
4945     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4946     iscol_s = iscol;
4947   }
4948 
4949   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4950 
4951   if (!rsorted || !csorted) {
4952     Mat      new_mat;
4953     IS       is_perm_r,is_perm_c;
4954 
4955     if (!rsorted) {
4956       PetscInt *idxs_r,i;
4957       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4958       for (i=0;i<rsize;i++) {
4959         idxs_r[idxs_perm_r[i]] = i;
4960       }
4961       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4962       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4963     } else {
4964       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4965     }
4966     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4967 
4968     if (!csorted) {
4969       if (isrow_s == iscol_s) {
4970         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4971         is_perm_c = is_perm_r;
4972       } else {
4973         PetscInt *idxs_c,i;
4974         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4975         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4976         for (i=0;i<csize;i++) {
4977           idxs_c[idxs_perm_c[i]] = i;
4978         }
4979         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4980         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4981       }
4982     } else {
4983       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4984     }
4985     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4986 
4987     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4988     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4989     work_mat[0] = new_mat;
4990     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4991     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4992   }
4993 
4994   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4995   *B = work_mat[0];
4996   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4997   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4998   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4999   PetscFunctionReturn(0);
5000 }
5001 
5002 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5003 {
5004   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5005   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5006   Mat            new_mat,lA;
5007   IS             is_local,is_global;
5008   PetscInt       local_size;
5009   PetscBool      isseqaij;
5010   PetscErrorCode ierr;
5011 
5012   PetscFunctionBegin;
5013   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5014   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5015   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5016   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5017   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5018   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5019   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5020 
5021   /* check */
5022   if (pcbddc->dbg_flag) {
5023     Vec       x,x_change;
5024     PetscReal error;
5025 
5026     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5027     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5028     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5029     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5030     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5031     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5032     if (!pcbddc->change_interior) {
5033       const PetscScalar *x,*y,*v;
5034       PetscReal         lerror = 0.;
5035       PetscInt          i;
5036 
5037       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5038       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5039       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5040       for (i=0;i<local_size;i++)
5041         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5042           lerror = PetscAbsScalar(x[i]-y[i]);
5043       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5044       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5045       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5046       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5047       if (error > PETSC_SMALL) {
5048         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5049           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5050         } else {
5051           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5052         }
5053       }
5054     }
5055     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5056     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5057     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5058     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5059     if (error > PETSC_SMALL) {
5060       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5061         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5062       } else {
5063         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5064       }
5065     }
5066     ierr = VecDestroy(&x);CHKERRQ(ierr);
5067     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5068   }
5069 
5070   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5071   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5072 
5073   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5074   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5075   if (isseqaij) {
5076     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5077     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5078     if (lA) {
5079       Mat work;
5080       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5081       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5082       ierr = MatDestroy(&work);CHKERRQ(ierr);
5083     }
5084   } else {
5085     Mat work_mat;
5086 
5087     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5088     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5089     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5090     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5091     if (lA) {
5092       Mat work;
5093       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5094       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5095       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5096       ierr = MatDestroy(&work);CHKERRQ(ierr);
5097     }
5098   }
5099   if (matis->A->symmetric_set) {
5100     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5101 #if !defined(PETSC_USE_COMPLEX)
5102     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5103 #endif
5104   }
5105   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5106   PetscFunctionReturn(0);
5107 }
5108 
5109 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5110 {
5111   PC_IS*          pcis = (PC_IS*)(pc->data);
5112   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5113   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5114   PetscInt        *idx_R_local=NULL;
5115   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5116   PetscInt        vbs,bs;
5117   PetscBT         bitmask=NULL;
5118   PetscErrorCode  ierr;
5119 
5120   PetscFunctionBegin;
5121   /*
5122     No need to setup local scatters if
5123       - primal space is unchanged
5124         AND
5125       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5126         AND
5127       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5128   */
5129   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5130     PetscFunctionReturn(0);
5131   }
5132   /* destroy old objects */
5133   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5134   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5135   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5136   /* Set Non-overlapping dimensions */
5137   n_B = pcis->n_B;
5138   n_D = pcis->n - n_B;
5139   n_vertices = pcbddc->n_vertices;
5140 
5141   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5142 
5143   /* create auxiliary bitmask and allocate workspace */
5144   if (!sub_schurs || !sub_schurs->reuse_solver) {
5145     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5146     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5147     for (i=0;i<n_vertices;i++) {
5148       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5149     }
5150 
5151     for (i=0, n_R=0; i<pcis->n; i++) {
5152       if (!PetscBTLookup(bitmask,i)) {
5153         idx_R_local[n_R++] = i;
5154       }
5155     }
5156   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5157     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5158 
5159     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5160     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5161   }
5162 
5163   /* Block code */
5164   vbs = 1;
5165   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5166   if (bs>1 && !(n_vertices%bs)) {
5167     PetscBool is_blocked = PETSC_TRUE;
5168     PetscInt  *vary;
5169     if (!sub_schurs || !sub_schurs->reuse_solver) {
5170       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5171       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5172       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5173       /* 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 */
5174       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5175       for (i=0; i<pcis->n/bs; i++) {
5176         if (vary[i]!=0 && vary[i]!=bs) {
5177           is_blocked = PETSC_FALSE;
5178           break;
5179         }
5180       }
5181       ierr = PetscFree(vary);CHKERRQ(ierr);
5182     } else {
5183       /* Verify directly the R set */
5184       for (i=0; i<n_R/bs; i++) {
5185         PetscInt j,node=idx_R_local[bs*i];
5186         for (j=1; j<bs; j++) {
5187           if (node != idx_R_local[bs*i+j]-j) {
5188             is_blocked = PETSC_FALSE;
5189             break;
5190           }
5191         }
5192       }
5193     }
5194     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5195       vbs = bs;
5196       for (i=0;i<n_R/vbs;i++) {
5197         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5198       }
5199     }
5200   }
5201   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5202   if (sub_schurs && sub_schurs->reuse_solver) {
5203     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5204 
5205     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5206     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5207     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5208     reuse_solver->is_R = pcbddc->is_R_local;
5209   } else {
5210     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5211   }
5212 
5213   /* print some info if requested */
5214   if (pcbddc->dbg_flag) {
5215     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5216     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5217     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5219     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5220     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);
5221     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5222   }
5223 
5224   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5225   if (!sub_schurs || !sub_schurs->reuse_solver) {
5226     IS       is_aux1,is_aux2;
5227     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5228 
5229     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5230     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5231     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5232     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5233     for (i=0; i<n_D; i++) {
5234       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5235     }
5236     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5237     for (i=0, j=0; i<n_R; i++) {
5238       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5239         aux_array1[j++] = i;
5240       }
5241     }
5242     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5243     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5244     for (i=0, j=0; i<n_B; i++) {
5245       if (!PetscBTLookup(bitmask,is_indices[i])) {
5246         aux_array2[j++] = i;
5247       }
5248     }
5249     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5250     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5251     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5252     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5253     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5254 
5255     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5256       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5257       for (i=0, j=0; i<n_R; i++) {
5258         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5259           aux_array1[j++] = i;
5260         }
5261       }
5262       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5263       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5264       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5265     }
5266     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5267     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5268   } else {
5269     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5270     IS                 tis;
5271     PetscInt           schur_size;
5272 
5273     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5274     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5275     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5276     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5277     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5278       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5279       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5280       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5281     }
5282   }
5283   PetscFunctionReturn(0);
5284 }
5285 
5286 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B)
5287 {
5288   MatNullSpace   NullSpace;
5289   Mat            dmat;
5290   const Vec      *nullvecs;
5291   Vec            v,v2,*nullvecs2;
5292   VecScatter     sct;
5293   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5294   PetscBool      nnsp_has_cnst;
5295   PetscErrorCode ierr;
5296 
5297   PetscFunctionBegin;
5298   ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5299   if (!NullSpace) {
5300     ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5301   }
5302   if (NullSpace) PetscFunctionReturn(0);
5303   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5304   if (!NullSpace) {
5305     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5306   }
5307   if (!NullSpace) PetscFunctionReturn(0);
5308   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5309   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5310   ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5311   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5312   bsiz = nnsp_size+!!nnsp_has_cnst;
5313   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5314   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5315   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5316   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5317   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5318   for (k=0;k<nnsp_size;k++) {
5319     PetscScalar *arr;
5320 
5321     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5322     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5323     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5324     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5325     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5326   }
5327   if (nnsp_has_cnst) {
5328     PetscScalar *arr;
5329 
5330     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5331     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5332     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5333     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5334   }
5335   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5336   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5337   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5338   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5339   for (k=0;k<bsiz;k++) {
5340     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5341   }
5342   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5343   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5344   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5345   ierr = VecDestroy(&v);CHKERRQ(ierr);
5346   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5347   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5348   PetscFunctionReturn(0);
5349 }
5350 
5351 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5352 {
5353   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5354   PC_IS          *pcis = (PC_IS*)pc->data;
5355   PC             pc_temp;
5356   Mat            A_RR;
5357   MatNullSpace   nnsp;
5358   MatReuse       reuse;
5359   PetscScalar    m_one = -1.0;
5360   PetscReal      value;
5361   PetscInt       n_D,n_R;
5362   PetscBool      issbaij,opts;
5363   PetscErrorCode ierr;
5364   void           (*f)(void) = 0;
5365   char           dir_prefix[256],neu_prefix[256],str_level[16];
5366   size_t         len;
5367 
5368   PetscFunctionBegin;
5369   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5370   /* compute prefixes */
5371   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5372   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5373   if (!pcbddc->current_level) {
5374     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5375     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5376     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5377     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5378   } else {
5379     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5380     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5381     len -= 15; /* remove "pc_bddc_coarse_" */
5382     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5383     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5384     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5385     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5386     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5387     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5388     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5389     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5390     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5391   }
5392 
5393   /* DIRICHLET PROBLEM */
5394   if (dirichlet) {
5395     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5396     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5397       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5398       if (pcbddc->dbg_flag) {
5399         Mat    A_IIn;
5400 
5401         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5402         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5403         pcis->A_II = A_IIn;
5404       }
5405     }
5406     if (pcbddc->local_mat->symmetric_set) {
5407       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5408     }
5409     /* Matrix for Dirichlet problem is pcis->A_II */
5410     n_D  = pcis->n - pcis->n_B;
5411     opts = PETSC_FALSE;
5412     if (!pcbddc->ksp_D) { /* create object if not yet build */
5413       opts = PETSC_TRUE;
5414       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5415       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5416       /* default */
5417       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5418       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5419       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5420       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5421       if (issbaij) {
5422         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5423       } else {
5424         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5425       }
5426       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5427     }
5428     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5429     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5430     /* Allow user's customization */
5431     if (opts) {
5432       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5433     }
5434     if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */
5435       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5436     }
5437     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5438     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5439     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5440     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5441       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5442       const PetscInt *idxs;
5443       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5444 
5445       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5446       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5447       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5448       for (i=0;i<nl;i++) {
5449         for (d=0;d<cdim;d++) {
5450           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5451         }
5452       }
5453       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5454       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5455       ierr = PetscFree(scoords);CHKERRQ(ierr);
5456     }
5457     if (sub_schurs && sub_schurs->reuse_solver) {
5458       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5459 
5460       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5461     }
5462 
5463     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5464     if (!n_D) {
5465       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5466       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5467     }
5468     /* set ksp_D into pcis data */
5469     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5470     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5471     pcis->ksp_D = pcbddc->ksp_D;
5472   }
5473 
5474   /* NEUMANN PROBLEM */
5475   A_RR = 0;
5476   if (neumann) {
5477     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5478     PetscInt        ibs,mbs;
5479     PetscBool       issbaij, reuse_neumann_solver;
5480     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5481 
5482     reuse_neumann_solver = PETSC_FALSE;
5483     if (sub_schurs && sub_schurs->reuse_solver) {
5484       IS iP;
5485 
5486       reuse_neumann_solver = PETSC_TRUE;
5487       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5488       if (iP) reuse_neumann_solver = PETSC_FALSE;
5489     }
5490     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5491     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5492     if (pcbddc->ksp_R) { /* already created ksp */
5493       PetscInt nn_R;
5494       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5495       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5496       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5497       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5498         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5499         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5500         reuse = MAT_INITIAL_MATRIX;
5501       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5502         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5503           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5504           reuse = MAT_INITIAL_MATRIX;
5505         } else { /* safe to reuse the matrix */
5506           reuse = MAT_REUSE_MATRIX;
5507         }
5508       }
5509       /* last check */
5510       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5511         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5512         reuse = MAT_INITIAL_MATRIX;
5513       }
5514     } else { /* first time, so we need to create the matrix */
5515       reuse = MAT_INITIAL_MATRIX;
5516     }
5517     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5518     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5519     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5520     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5521     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5522       if (matis->A == pcbddc->local_mat) {
5523         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5524         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5525       } else {
5526         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5527       }
5528     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5529       if (matis->A == pcbddc->local_mat) {
5530         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5531         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5532       } else {
5533         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5534       }
5535     }
5536     /* extract A_RR */
5537     if (reuse_neumann_solver) {
5538       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5539 
5540       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5541         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5542         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5543           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5544         } else {
5545           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5546         }
5547       } else {
5548         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5549         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5550         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5551       }
5552     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5553       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5554     }
5555     if (pcbddc->local_mat->symmetric_set) {
5556       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5557     }
5558     opts = PETSC_FALSE;
5559     if (!pcbddc->ksp_R) { /* create object if not present */
5560       opts = PETSC_TRUE;
5561       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5562       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5563       /* default */
5564       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5565       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5566       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5567       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5568       if (issbaij) {
5569         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5570       } else {
5571         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5572       }
5573       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5574     }
5575     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5576     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5577     if (opts) { /* Allow user's customization once */
5578       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5579     }
5580     if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */
5581       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5582     }
5583     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5584     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5585     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5586     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5587       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5588       const PetscInt *idxs;
5589       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5590 
5591       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5592       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5593       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5594       for (i=0;i<nl;i++) {
5595         for (d=0;d<cdim;d++) {
5596           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5597         }
5598       }
5599       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5600       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5601       ierr = PetscFree(scoords);CHKERRQ(ierr);
5602     }
5603 
5604     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5605     if (!n_R) {
5606       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5607       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5608     }
5609     /* Reuse solver if it is present */
5610     if (reuse_neumann_solver) {
5611       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5612 
5613       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5614     }
5615   }
5616 
5617   if (pcbddc->dbg_flag) {
5618     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5619     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5620     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5621   }
5622   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5623 
5624   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5625   if (pcbddc->NullSpace_corr[0]) {
5626     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5627   }
5628   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5629     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5630   }
5631   if (neumann && pcbddc->NullSpace_corr[2]) {
5632     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5633   }
5634   /* check Dirichlet and Neumann solvers */
5635   if (pcbddc->dbg_flag) {
5636     if (dirichlet) { /* Dirichlet */
5637       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5638       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5639       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5640       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5641       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5642       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5643       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);
5644       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5645     }
5646     if (neumann) { /* Neumann */
5647       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5648       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5649       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5650       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5651       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5652       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5653       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);
5654       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5655     }
5656   }
5657   /* free Neumann problem's matrix */
5658   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5659   PetscFunctionReturn(0);
5660 }
5661 
5662 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5663 {
5664   PetscErrorCode  ierr;
5665   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5666   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5667   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5668 
5669   PetscFunctionBegin;
5670   if (!reuse_solver) {
5671     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5672   }
5673   if (!pcbddc->switch_static) {
5674     if (applytranspose && pcbddc->local_auxmat1) {
5675       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5676       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5677     }
5678     if (!reuse_solver) {
5679       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5680       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5681     } else {
5682       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5683 
5684       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5685       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5686     }
5687   } else {
5688     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5689     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5690     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5691     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5692     if (applytranspose && pcbddc->local_auxmat1) {
5693       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5694       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5695       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5696       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5697     }
5698   }
5699   if (!reuse_solver || pcbddc->switch_static) {
5700     if (applytranspose) {
5701       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5702     } else {
5703       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5704     }
5705     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5706   } else {
5707     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5708 
5709     if (applytranspose) {
5710       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5711     } else {
5712       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5713     }
5714   }
5715   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5716   if (!pcbddc->switch_static) {
5717     if (!reuse_solver) {
5718       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5719       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5720     } else {
5721       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5722 
5723       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5724       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5725     }
5726     if (!applytranspose && pcbddc->local_auxmat1) {
5727       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5728       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5729     }
5730   } else {
5731     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5732     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5733     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5734     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5735     if (!applytranspose && pcbddc->local_auxmat1) {
5736       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5737       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5738     }
5739     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5740     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5741     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5742     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5743   }
5744   PetscFunctionReturn(0);
5745 }
5746 
5747 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5748 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5749 {
5750   PetscErrorCode ierr;
5751   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5752   PC_IS*            pcis = (PC_IS*)  (pc->data);
5753   const PetscScalar zero = 0.0;
5754 
5755   PetscFunctionBegin;
5756   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5757   if (!pcbddc->benign_apply_coarse_only) {
5758     if (applytranspose) {
5759       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5760       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5761     } else {
5762       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5763       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5764     }
5765   } else {
5766     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5767   }
5768 
5769   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5770   if (pcbddc->benign_n) {
5771     PetscScalar *array;
5772     PetscInt    j;
5773 
5774     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5775     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5776     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5777   }
5778 
5779   /* start communications from local primal nodes to rhs of coarse solver */
5780   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5781   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5782   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5783 
5784   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5785   if (pcbddc->coarse_ksp) {
5786     Mat          coarse_mat;
5787     Vec          rhs,sol;
5788     MatNullSpace nullsp;
5789     PetscBool    isbddc = PETSC_FALSE;
5790 
5791     if (pcbddc->benign_have_null) {
5792       PC        coarse_pc;
5793 
5794       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5795       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5796       /* we need to propagate to coarser levels the need for a possible benign correction */
5797       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5798         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5799         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5800         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5801       }
5802     }
5803     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5804     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5805     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5806     if (applytranspose) {
5807       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5808       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5809       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5810       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5811       if (nullsp) {
5812         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5813       }
5814     } else {
5815       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5816       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5817         PC        coarse_pc;
5818 
5819         if (nullsp) {
5820           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5821         }
5822         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5823         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5824         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5825         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5826       } else {
5827         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5828         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5829         if (nullsp) {
5830           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5831         }
5832       }
5833     }
5834     /* we don't need the benign correction at coarser levels anymore */
5835     if (pcbddc->benign_have_null && isbddc) {
5836       PC        coarse_pc;
5837       PC_BDDC*  coarsepcbddc;
5838 
5839       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5840       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5841       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5842       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5843     }
5844   }
5845 
5846   /* Local solution on R nodes */
5847   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5848     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5849   }
5850   /* communications from coarse sol to local primal nodes */
5851   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5852   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5853 
5854   /* Sum contributions from the two levels */
5855   if (!pcbddc->benign_apply_coarse_only) {
5856     if (applytranspose) {
5857       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5858       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5859     } else {
5860       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5861       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5862     }
5863     /* store p0 */
5864     if (pcbddc->benign_n) {
5865       PetscScalar *array;
5866       PetscInt    j;
5867 
5868       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5869       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5870       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5871     }
5872   } else { /* expand the coarse solution */
5873     if (applytranspose) {
5874       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5875     } else {
5876       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5877     }
5878   }
5879   PetscFunctionReturn(0);
5880 }
5881 
5882 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5883 {
5884   PetscErrorCode ierr;
5885   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5886   PetscScalar    *array;
5887   Vec            from,to;
5888 
5889   PetscFunctionBegin;
5890   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5891     from = pcbddc->coarse_vec;
5892     to = pcbddc->vec1_P;
5893     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5894       Vec tvec;
5895 
5896       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5897       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5898       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5899       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5900       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5901       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5902     }
5903   } else { /* from local to global -> put data in coarse right hand side */
5904     from = pcbddc->vec1_P;
5905     to = pcbddc->coarse_vec;
5906   }
5907   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5908   PetscFunctionReturn(0);
5909 }
5910 
5911 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5912 {
5913   PetscErrorCode ierr;
5914   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5915   PetscScalar    *array;
5916   Vec            from,to;
5917 
5918   PetscFunctionBegin;
5919   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5920     from = pcbddc->coarse_vec;
5921     to = pcbddc->vec1_P;
5922   } else { /* from local to global -> put data in coarse right hand side */
5923     from = pcbddc->vec1_P;
5924     to = pcbddc->coarse_vec;
5925   }
5926   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5927   if (smode == SCATTER_FORWARD) {
5928     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5929       Vec tvec;
5930 
5931       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5932       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5933       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5934       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5935     }
5936   } else {
5937     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5938      ierr = VecResetArray(from);CHKERRQ(ierr);
5939     }
5940   }
5941   PetscFunctionReturn(0);
5942 }
5943 
5944 /* uncomment for testing purposes */
5945 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5946 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5947 {
5948   PetscErrorCode    ierr;
5949   PC_IS*            pcis = (PC_IS*)(pc->data);
5950   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5951   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5952   /* one and zero */
5953   PetscScalar       one=1.0,zero=0.0;
5954   /* space to store constraints and their local indices */
5955   PetscScalar       *constraints_data;
5956   PetscInt          *constraints_idxs,*constraints_idxs_B;
5957   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5958   PetscInt          *constraints_n;
5959   /* iterators */
5960   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5961   /* BLAS integers */
5962   PetscBLASInt      lwork,lierr;
5963   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5964   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5965   /* reuse */
5966   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5967   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5968   /* change of basis */
5969   PetscBool         qr_needed;
5970   PetscBT           change_basis,qr_needed_idx;
5971   /* auxiliary stuff */
5972   PetscInt          *nnz,*is_indices;
5973   PetscInt          ncc;
5974   /* some quantities */
5975   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5976   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5977   PetscReal         tol; /* tolerance for retaining eigenmodes */
5978 
5979   PetscFunctionBegin;
5980   tol  = PetscSqrtReal(PETSC_SMALL);
5981   /* Destroy Mat objects computed previously */
5982   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5983   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5984   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5985   /* save info on constraints from previous setup (if any) */
5986   olocal_primal_size = pcbddc->local_primal_size;
5987   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5988   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5989   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
5990   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
5991   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5992   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5993 
5994   if (!pcbddc->adaptive_selection) {
5995     IS           ISForVertices,*ISForFaces,*ISForEdges;
5996     MatNullSpace nearnullsp;
5997     const Vec    *nearnullvecs;
5998     Vec          *localnearnullsp;
5999     PetscScalar  *array;
6000     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6001     PetscBool    nnsp_has_cnst;
6002     /* LAPACK working arrays for SVD or POD */
6003     PetscBool    skip_lapack,boolforchange;
6004     PetscScalar  *work;
6005     PetscReal    *singular_vals;
6006 #if defined(PETSC_USE_COMPLEX)
6007     PetscReal    *rwork;
6008 #endif
6009 #if defined(PETSC_MISSING_LAPACK_GESVD)
6010     PetscScalar  *temp_basis,*correlation_mat;
6011 #else
6012     PetscBLASInt dummy_int=1;
6013     PetscScalar  dummy_scalar=1.;
6014 #endif
6015 
6016     /* Get index sets for faces, edges and vertices from graph */
6017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6018     /* print some info */
6019     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6020       PetscInt nv;
6021 
6022       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6023       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6024       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6025       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6026       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6027       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6028       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6029       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6030       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6031     }
6032 
6033     /* free unneeded index sets */
6034     if (!pcbddc->use_vertices) {
6035       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6036     }
6037     if (!pcbddc->use_edges) {
6038       for (i=0;i<n_ISForEdges;i++) {
6039         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6040       }
6041       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6042       n_ISForEdges = 0;
6043     }
6044     if (!pcbddc->use_faces) {
6045       for (i=0;i<n_ISForFaces;i++) {
6046         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6047       }
6048       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6049       n_ISForFaces = 0;
6050     }
6051 
6052     /* check if near null space is attached to global mat */
6053     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6054     if (nearnullsp) {
6055       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6056       /* remove any stored info */
6057       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6058       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6059       /* store information for BDDC solver reuse */
6060       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6061       pcbddc->onearnullspace = nearnullsp;
6062       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6063       for (i=0;i<nnsp_size;i++) {
6064         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6065       }
6066     } else { /* if near null space is not provided BDDC uses constants by default */
6067       nnsp_size = 0;
6068       nnsp_has_cnst = PETSC_TRUE;
6069     }
6070     /* get max number of constraints on a single cc */
6071     max_constraints = nnsp_size;
6072     if (nnsp_has_cnst) max_constraints++;
6073 
6074     /*
6075          Evaluate maximum storage size needed by the procedure
6076          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6077          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6078          There can be multiple constraints per connected component
6079                                                                                                                                                            */
6080     n_vertices = 0;
6081     if (ISForVertices) {
6082       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6083     }
6084     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6085     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6086 
6087     total_counts = n_ISForFaces+n_ISForEdges;
6088     total_counts *= max_constraints;
6089     total_counts += n_vertices;
6090     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6091 
6092     total_counts = 0;
6093     max_size_of_constraint = 0;
6094     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6095       IS used_is;
6096       if (i<n_ISForEdges) {
6097         used_is = ISForEdges[i];
6098       } else {
6099         used_is = ISForFaces[i-n_ISForEdges];
6100       }
6101       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6102       total_counts += j;
6103       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6104     }
6105     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);
6106 
6107     /* get local part of global near null space vectors */
6108     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6109     for (k=0;k<nnsp_size;k++) {
6110       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6111       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6112       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6113     }
6114 
6115     /* whether or not to skip lapack calls */
6116     skip_lapack = PETSC_TRUE;
6117     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6118 
6119     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6120     if (!skip_lapack) {
6121       PetscScalar temp_work;
6122 
6123 #if defined(PETSC_MISSING_LAPACK_GESVD)
6124       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6125       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6126       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6127       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6128 #if defined(PETSC_USE_COMPLEX)
6129       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6130 #endif
6131       /* now we evaluate the optimal workspace using query with lwork=-1 */
6132       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6133       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6134       lwork = -1;
6135       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6136 #if !defined(PETSC_USE_COMPLEX)
6137       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6138 #else
6139       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6140 #endif
6141       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6142       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6143 #else /* on missing GESVD */
6144       /* SVD */
6145       PetscInt max_n,min_n;
6146       max_n = max_size_of_constraint;
6147       min_n = max_constraints;
6148       if (max_size_of_constraint < max_constraints) {
6149         min_n = max_size_of_constraint;
6150         max_n = max_constraints;
6151       }
6152       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6153 #if defined(PETSC_USE_COMPLEX)
6154       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6155 #endif
6156       /* now we evaluate the optimal workspace using query with lwork=-1 */
6157       lwork = -1;
6158       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6159       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6160       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6161       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6162 #if !defined(PETSC_USE_COMPLEX)
6163       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
6164 #else
6165       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));
6166 #endif
6167       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6168       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6169 #endif /* on missing GESVD */
6170       /* Allocate optimal workspace */
6171       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6172       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6173     }
6174     /* Now we can loop on constraining sets */
6175     total_counts = 0;
6176     constraints_idxs_ptr[0] = 0;
6177     constraints_data_ptr[0] = 0;
6178     /* vertices */
6179     if (n_vertices) {
6180       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6181       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6182       for (i=0;i<n_vertices;i++) {
6183         constraints_n[total_counts] = 1;
6184         constraints_data[total_counts] = 1.0;
6185         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6186         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6187         total_counts++;
6188       }
6189       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6190       n_vertices = total_counts;
6191     }
6192 
6193     /* edges and faces */
6194     total_counts_cc = total_counts;
6195     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6196       IS        used_is;
6197       PetscBool idxs_copied = PETSC_FALSE;
6198 
6199       if (ncc<n_ISForEdges) {
6200         used_is = ISForEdges[ncc];
6201         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6202       } else {
6203         used_is = ISForFaces[ncc-n_ISForEdges];
6204         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6205       }
6206       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6207 
6208       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6209       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6210       /* change of basis should not be performed on local periodic nodes */
6211       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6212       if (nnsp_has_cnst) {
6213         PetscScalar quad_value;
6214 
6215         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6216         idxs_copied = PETSC_TRUE;
6217 
6218         if (!pcbddc->use_nnsp_true) {
6219           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6220         } else {
6221           quad_value = 1.0;
6222         }
6223         for (j=0;j<size_of_constraint;j++) {
6224           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6225         }
6226         temp_constraints++;
6227         total_counts++;
6228       }
6229       for (k=0;k<nnsp_size;k++) {
6230         PetscReal real_value;
6231         PetscScalar *ptr_to_data;
6232 
6233         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6234         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6235         for (j=0;j<size_of_constraint;j++) {
6236           ptr_to_data[j] = array[is_indices[j]];
6237         }
6238         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6239         /* check if array is null on the connected component */
6240         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6241         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6242         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6243           temp_constraints++;
6244           total_counts++;
6245           if (!idxs_copied) {
6246             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6247             idxs_copied = PETSC_TRUE;
6248           }
6249         }
6250       }
6251       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6252       valid_constraints = temp_constraints;
6253       if (!pcbddc->use_nnsp_true && temp_constraints) {
6254         if (temp_constraints == 1) { /* just normalize the constraint */
6255           PetscScalar norm,*ptr_to_data;
6256 
6257           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6258           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6259           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6260           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6261           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6262         } else { /* perform SVD */
6263           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6264 
6265 #if defined(PETSC_MISSING_LAPACK_GESVD)
6266           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6267              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6268              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6269                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6270                 from that computed using LAPACKgesvd
6271              -> This is due to a different computation of eigenvectors in LAPACKheev
6272              -> The quality of the POD-computed basis will be the same */
6273           ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6274           /* Store upper triangular part of correlation matrix */
6275           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6276           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6277           for (j=0;j<temp_constraints;j++) {
6278             for (k=0;k<j+1;k++) {
6279               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));
6280             }
6281           }
6282           /* compute eigenvalues and eigenvectors of correlation matrix */
6283           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6284           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6285 #if !defined(PETSC_USE_COMPLEX)
6286           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6287 #else
6288           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6289 #endif
6290           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6291           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6292           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6293           j = 0;
6294           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6295           total_counts = total_counts-j;
6296           valid_constraints = temp_constraints-j;
6297           /* scale and copy POD basis into used quadrature memory */
6298           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6299           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6300           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6301           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6302           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6303           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6304           if (j<temp_constraints) {
6305             PetscInt ii;
6306             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6307             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6308             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));
6309             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6310             for (k=0;k<temp_constraints-j;k++) {
6311               for (ii=0;ii<size_of_constraint;ii++) {
6312                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6313               }
6314             }
6315           }
6316 #else  /* on missing GESVD */
6317           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6318           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6319           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6320           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6321 #if !defined(PETSC_USE_COMPLEX)
6322           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
6323 #else
6324           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));
6325 #endif
6326           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6327           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6328           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6329           k = temp_constraints;
6330           if (k > size_of_constraint) k = size_of_constraint;
6331           j = 0;
6332           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6333           valid_constraints = k-j;
6334           total_counts = total_counts-temp_constraints+valid_constraints;
6335 #endif /* on missing GESVD */
6336         }
6337       }
6338       /* update pointers information */
6339       if (valid_constraints) {
6340         constraints_n[total_counts_cc] = valid_constraints;
6341         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6342         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6343         /* set change_of_basis flag */
6344         if (boolforchange) {
6345           PetscBTSet(change_basis,total_counts_cc);
6346         }
6347         total_counts_cc++;
6348       }
6349     }
6350     /* free workspace */
6351     if (!skip_lapack) {
6352       ierr = PetscFree(work);CHKERRQ(ierr);
6353 #if defined(PETSC_USE_COMPLEX)
6354       ierr = PetscFree(rwork);CHKERRQ(ierr);
6355 #endif
6356       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6357 #if defined(PETSC_MISSING_LAPACK_GESVD)
6358       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6359       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6360 #endif
6361     }
6362     for (k=0;k<nnsp_size;k++) {
6363       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6364     }
6365     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6366     /* free index sets of faces, edges and vertices */
6367     for (i=0;i<n_ISForFaces;i++) {
6368       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6369     }
6370     if (n_ISForFaces) {
6371       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6372     }
6373     for (i=0;i<n_ISForEdges;i++) {
6374       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6375     }
6376     if (n_ISForEdges) {
6377       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6378     }
6379     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6380   } else {
6381     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6382 
6383     total_counts = 0;
6384     n_vertices = 0;
6385     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6386       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6387     }
6388     max_constraints = 0;
6389     total_counts_cc = 0;
6390     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6391       total_counts += pcbddc->adaptive_constraints_n[i];
6392       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6393       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6394     }
6395     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6396     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6397     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6398     constraints_data = pcbddc->adaptive_constraints_data;
6399     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6400     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6401     total_counts_cc = 0;
6402     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6403       if (pcbddc->adaptive_constraints_n[i]) {
6404         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6405       }
6406     }
6407 
6408     max_size_of_constraint = 0;
6409     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]);
6410     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6411     /* Change of basis */
6412     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6413     if (pcbddc->use_change_of_basis) {
6414       for (i=0;i<sub_schurs->n_subs;i++) {
6415         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6416           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6417         }
6418       }
6419     }
6420   }
6421   pcbddc->local_primal_size = total_counts;
6422   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6423 
6424   /* map constraints_idxs in boundary numbering */
6425   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6426   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);
6427 
6428   /* Create constraint matrix */
6429   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6430   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6431   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6432 
6433   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6434   /* determine if a QR strategy is needed for change of basis */
6435   qr_needed = pcbddc->use_qr_single;
6436   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6437   total_primal_vertices=0;
6438   pcbddc->local_primal_size_cc = 0;
6439   for (i=0;i<total_counts_cc;i++) {
6440     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6441     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6442       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6443       pcbddc->local_primal_size_cc += 1;
6444     } else if (PetscBTLookup(change_basis,i)) {
6445       for (k=0;k<constraints_n[i];k++) {
6446         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6447       }
6448       pcbddc->local_primal_size_cc += constraints_n[i];
6449       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6450         PetscBTSet(qr_needed_idx,i);
6451         qr_needed = PETSC_TRUE;
6452       }
6453     } else {
6454       pcbddc->local_primal_size_cc += 1;
6455     }
6456   }
6457   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6458   pcbddc->n_vertices = total_primal_vertices;
6459   /* permute indices in order to have a sorted set of vertices */
6460   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6461   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);
6462   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6463   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6464 
6465   /* nonzero structure of constraint matrix */
6466   /* and get reference dof for local constraints */
6467   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6468   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6469 
6470   j = total_primal_vertices;
6471   total_counts = total_primal_vertices;
6472   cum = total_primal_vertices;
6473   for (i=n_vertices;i<total_counts_cc;i++) {
6474     if (!PetscBTLookup(change_basis,i)) {
6475       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6476       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6477       cum++;
6478       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6479       for (k=0;k<constraints_n[i];k++) {
6480         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6481         nnz[j+k] = size_of_constraint;
6482       }
6483       j += constraints_n[i];
6484     }
6485   }
6486   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6487   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6488   ierr = PetscFree(nnz);CHKERRQ(ierr);
6489 
6490   /* set values in constraint matrix */
6491   for (i=0;i<total_primal_vertices;i++) {
6492     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6493   }
6494   total_counts = total_primal_vertices;
6495   for (i=n_vertices;i<total_counts_cc;i++) {
6496     if (!PetscBTLookup(change_basis,i)) {
6497       PetscInt *cols;
6498 
6499       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6500       cols = constraints_idxs+constraints_idxs_ptr[i];
6501       for (k=0;k<constraints_n[i];k++) {
6502         PetscInt    row = total_counts+k;
6503         PetscScalar *vals;
6504 
6505         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6506         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6507       }
6508       total_counts += constraints_n[i];
6509     }
6510   }
6511   /* assembling */
6512   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6513   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6514   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6515 
6516   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6517   if (pcbddc->use_change_of_basis) {
6518     /* dual and primal dofs on a single cc */
6519     PetscInt     dual_dofs,primal_dofs;
6520     /* working stuff for GEQRF */
6521     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6522     PetscBLASInt lqr_work;
6523     /* working stuff for UNGQR */
6524     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6525     PetscBLASInt lgqr_work;
6526     /* working stuff for TRTRS */
6527     PetscScalar  *trs_rhs = NULL;
6528     PetscBLASInt Blas_NRHS;
6529     /* pointers for values insertion into change of basis matrix */
6530     PetscInt     *start_rows,*start_cols;
6531     PetscScalar  *start_vals;
6532     /* working stuff for values insertion */
6533     PetscBT      is_primal;
6534     PetscInt     *aux_primal_numbering_B;
6535     /* matrix sizes */
6536     PetscInt     global_size,local_size;
6537     /* temporary change of basis */
6538     Mat          localChangeOfBasisMatrix;
6539     /* extra space for debugging */
6540     PetscScalar  *dbg_work = NULL;
6541 
6542     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6543     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6544     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6545     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6546     /* nonzeros for local mat */
6547     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6548     if (!pcbddc->benign_change || pcbddc->fake_change) {
6549       for (i=0;i<pcis->n;i++) nnz[i]=1;
6550     } else {
6551       const PetscInt *ii;
6552       PetscInt       n;
6553       PetscBool      flg_row;
6554       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6555       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6556       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6557     }
6558     for (i=n_vertices;i<total_counts_cc;i++) {
6559       if (PetscBTLookup(change_basis,i)) {
6560         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6561         if (PetscBTLookup(qr_needed_idx,i)) {
6562           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6563         } else {
6564           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6565           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6566         }
6567       }
6568     }
6569     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6570     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6571     ierr = PetscFree(nnz);CHKERRQ(ierr);
6572     /* Set interior change in the matrix */
6573     if (!pcbddc->benign_change || pcbddc->fake_change) {
6574       for (i=0;i<pcis->n;i++) {
6575         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6576       }
6577     } else {
6578       const PetscInt *ii,*jj;
6579       PetscScalar    *aa;
6580       PetscInt       n;
6581       PetscBool      flg_row;
6582       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6583       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6584       for (i=0;i<n;i++) {
6585         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6586       }
6587       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6588       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6589     }
6590 
6591     if (pcbddc->dbg_flag) {
6592       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6593       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6594     }
6595 
6596 
6597     /* Now we loop on the constraints which need a change of basis */
6598     /*
6599        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6600        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6601 
6602        Basic blocks of change of basis matrix T computed by
6603 
6604           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6605 
6606             | 1        0   ...        0         s_1/S |
6607             | 0        1   ...        0         s_2/S |
6608             |              ...                        |
6609             | 0        ...            1     s_{n-1}/S |
6610             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6611 
6612             with S = \sum_{i=1}^n s_i^2
6613             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6614                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6615 
6616           - QR decomposition of constraints otherwise
6617     */
6618     if (qr_needed && max_size_of_constraint) {
6619       /* space to store Q */
6620       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6621       /* array to store scaling factors for reflectors */
6622       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6623       /* first we issue queries for optimal work */
6624       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6625       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6626       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6627       lqr_work = -1;
6628       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6629       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6630       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6631       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6632       lgqr_work = -1;
6633       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6634       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6635       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6636       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6637       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6638       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6639       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6640       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6641       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6642       /* array to store rhs and solution of triangular solver */
6643       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6644       /* allocating workspace for check */
6645       if (pcbddc->dbg_flag) {
6646         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6647       }
6648     }
6649     /* array to store whether a node is primal or not */
6650     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6651     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6652     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6653     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);
6654     for (i=0;i<total_primal_vertices;i++) {
6655       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6656     }
6657     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6658 
6659     /* loop on constraints and see whether or not they need a change of basis and compute it */
6660     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6661       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6662       if (PetscBTLookup(change_basis,total_counts)) {
6663         /* get constraint info */
6664         primal_dofs = constraints_n[total_counts];
6665         dual_dofs = size_of_constraint-primal_dofs;
6666 
6667         if (pcbddc->dbg_flag) {
6668           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);
6669         }
6670 
6671         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6672 
6673           /* copy quadrature constraints for change of basis check */
6674           if (pcbddc->dbg_flag) {
6675             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6676           }
6677           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6678           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6679 
6680           /* compute QR decomposition of constraints */
6681           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6682           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6683           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6684           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6685           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6686           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6687           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6688 
6689           /* explictly compute R^-T */
6690           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6691           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6692           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6693           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6694           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6695           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6696           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6697           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6698           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6699           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6700 
6701           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6702           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6703           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6704           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6705           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6706           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6707           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6708           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6709           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6710 
6711           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6712              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6713              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6714           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6715           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6716           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6717           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6718           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6719           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6720           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6721           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));
6722           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6723           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6724 
6725           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6726           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6727           /* insert cols for primal dofs */
6728           for (j=0;j<primal_dofs;j++) {
6729             start_vals = &qr_basis[j*size_of_constraint];
6730             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6731             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6732           }
6733           /* insert cols for dual dofs */
6734           for (j=0,k=0;j<dual_dofs;k++) {
6735             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6736               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6737               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6738               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6739               j++;
6740             }
6741           }
6742 
6743           /* check change of basis */
6744           if (pcbddc->dbg_flag) {
6745             PetscInt   ii,jj;
6746             PetscBool valid_qr=PETSC_TRUE;
6747             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6748             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6749             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6750             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6751             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6752             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6753             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6754             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));
6755             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6756             for (jj=0;jj<size_of_constraint;jj++) {
6757               for (ii=0;ii<primal_dofs;ii++) {
6758                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6759                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6760               }
6761             }
6762             if (!valid_qr) {
6763               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6764               for (jj=0;jj<size_of_constraint;jj++) {
6765                 for (ii=0;ii<primal_dofs;ii++) {
6766                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6767                     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);
6768                   }
6769                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6770                     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);
6771                   }
6772                 }
6773               }
6774             } else {
6775               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6776             }
6777           }
6778         } else { /* simple transformation block */
6779           PetscInt    row,col;
6780           PetscScalar val,norm;
6781 
6782           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6783           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6784           for (j=0;j<size_of_constraint;j++) {
6785             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6786             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6787             if (!PetscBTLookup(is_primal,row_B)) {
6788               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6789               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6790               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6791             } else {
6792               for (k=0;k<size_of_constraint;k++) {
6793                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6794                 if (row != col) {
6795                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6796                 } else {
6797                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6798                 }
6799                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6800               }
6801             }
6802           }
6803           if (pcbddc->dbg_flag) {
6804             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6805           }
6806         }
6807       } else {
6808         if (pcbddc->dbg_flag) {
6809           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6810         }
6811       }
6812     }
6813 
6814     /* free workspace */
6815     if (qr_needed) {
6816       if (pcbddc->dbg_flag) {
6817         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6818       }
6819       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6820       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6821       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6822       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6823       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6824     }
6825     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6826     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6827     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6828 
6829     /* assembling of global change of variable */
6830     if (!pcbddc->fake_change) {
6831       Mat      tmat;
6832       PetscInt bs;
6833 
6834       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6835       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6836       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6837       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6838       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6839       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6840       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6841       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6842       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6843       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6844       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6845       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6846       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6847       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6848       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6849       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6850       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6851       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6852       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6853       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6854 
6855       /* check */
6856       if (pcbddc->dbg_flag) {
6857         PetscReal error;
6858         Vec       x,x_change;
6859 
6860         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6861         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6862         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6863         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6864         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6865         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6866         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6867         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6868         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6869         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6870         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6871         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6872         if (error > PETSC_SMALL) {
6873           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6874         }
6875         ierr = VecDestroy(&x);CHKERRQ(ierr);
6876         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6877       }
6878       /* adapt sub_schurs computed (if any) */
6879       if (pcbddc->use_deluxe_scaling) {
6880         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6881 
6882         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");
6883         if (sub_schurs && sub_schurs->S_Ej_all) {
6884           Mat                    S_new,tmat;
6885           IS                     is_all_N,is_V_Sall = NULL;
6886 
6887           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6888           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6889           if (pcbddc->deluxe_zerorows) {
6890             ISLocalToGlobalMapping NtoSall;
6891             IS                     is_V;
6892             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6893             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6894             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6895             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6896             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6897           }
6898           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6899           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6900           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6901           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6902           if (pcbddc->deluxe_zerorows) {
6903             const PetscScalar *array;
6904             const PetscInt    *idxs_V,*idxs_all;
6905             PetscInt          i,n_V;
6906 
6907             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6908             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6909             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6910             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6911             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6912             for (i=0;i<n_V;i++) {
6913               PetscScalar val;
6914               PetscInt    idx;
6915 
6916               idx = idxs_V[i];
6917               val = array[idxs_all[idxs_V[i]]];
6918               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6919             }
6920             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6921             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6922             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6923             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6924             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6925           }
6926           sub_schurs->S_Ej_all = S_new;
6927           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6928           if (sub_schurs->sum_S_Ej_all) {
6929             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6930             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6931             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6932             if (pcbddc->deluxe_zerorows) {
6933               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6934             }
6935             sub_schurs->sum_S_Ej_all = S_new;
6936             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6937           }
6938           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6939           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6940         }
6941         /* destroy any change of basis context in sub_schurs */
6942         if (sub_schurs && sub_schurs->change) {
6943           PetscInt i;
6944 
6945           for (i=0;i<sub_schurs->n_subs;i++) {
6946             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6947           }
6948           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6949         }
6950       }
6951       if (pcbddc->switch_static) { /* need to save the local change */
6952         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6953       } else {
6954         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6955       }
6956       /* determine if any process has changed the pressures locally */
6957       pcbddc->change_interior = pcbddc->benign_have_null;
6958     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6959       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6960       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6961       pcbddc->use_qr_single = qr_needed;
6962     }
6963   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6964     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6965       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6966       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6967     } else {
6968       Mat benign_global = NULL;
6969       if (pcbddc->benign_have_null) {
6970         Mat M;
6971 
6972         pcbddc->change_interior = PETSC_TRUE;
6973         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6974         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6975         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6976         if (pcbddc->benign_change) {
6977           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6978           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6979         } else {
6980           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6981           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6982         }
6983         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6984         ierr = MatDestroy(&M);CHKERRQ(ierr);
6985         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6986         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6987       }
6988       if (pcbddc->user_ChangeOfBasisMatrix) {
6989         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6990         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6991       } else if (pcbddc->benign_have_null) {
6992         pcbddc->ChangeOfBasisMatrix = benign_global;
6993       }
6994     }
6995     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6996       IS             is_global;
6997       const PetscInt *gidxs;
6998 
6999       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7000       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7001       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7002       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7003       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7004     }
7005   }
7006   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7007     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7008   }
7009 
7010   if (!pcbddc->fake_change) {
7011     /* add pressure dofs to set of primal nodes for numbering purposes */
7012     for (i=0;i<pcbddc->benign_n;i++) {
7013       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7014       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7015       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7016       pcbddc->local_primal_size_cc++;
7017       pcbddc->local_primal_size++;
7018     }
7019 
7020     /* check if a new primal space has been introduced (also take into account benign trick) */
7021     pcbddc->new_primal_space_local = PETSC_TRUE;
7022     if (olocal_primal_size == pcbddc->local_primal_size) {
7023       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7024       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7025       if (!pcbddc->new_primal_space_local) {
7026         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7027         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7028       }
7029     }
7030     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7031     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7032   }
7033   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7034 
7035   /* flush dbg viewer */
7036   if (pcbddc->dbg_flag) {
7037     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7038   }
7039 
7040   /* free workspace */
7041   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7042   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7043   if (!pcbddc->adaptive_selection) {
7044     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7045     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7046   } else {
7047     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7048                       pcbddc->adaptive_constraints_idxs_ptr,
7049                       pcbddc->adaptive_constraints_data_ptr,
7050                       pcbddc->adaptive_constraints_idxs,
7051                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7052     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7053     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7054   }
7055   PetscFunctionReturn(0);
7056 }
7057 /* #undef PETSC_MISSING_LAPACK_GESVD */
7058 
7059 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7060 {
7061   ISLocalToGlobalMapping map;
7062   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7063   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7064   PetscInt               i,N;
7065   PetscBool              rcsr = PETSC_FALSE;
7066   PetscErrorCode         ierr;
7067 
7068   PetscFunctionBegin;
7069   if (pcbddc->recompute_topography) {
7070     pcbddc->graphanalyzed = PETSC_FALSE;
7071     /* Reset previously computed graph */
7072     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7073     /* Init local Graph struct */
7074     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7075     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7076     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7077 
7078     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7079       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7080     }
7081     /* Check validity of the csr graph passed in by the user */
7082     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);
7083 
7084     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7085     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7086       PetscInt  *xadj,*adjncy;
7087       PetscInt  nvtxs;
7088       PetscBool flg_row=PETSC_FALSE;
7089 
7090       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7091       if (flg_row) {
7092         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7093         pcbddc->computed_rowadj = PETSC_TRUE;
7094       }
7095       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7096       rcsr = PETSC_TRUE;
7097     }
7098     if (pcbddc->dbg_flag) {
7099       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7100     }
7101 
7102     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7103       PetscReal    *lcoords;
7104       PetscInt     n;
7105       MPI_Datatype dimrealtype;
7106 
7107       /* TODO: support for blocked */
7108       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);
7109       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7110       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7111       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7112       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7113       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7114       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7115       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7116       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7117 
7118       pcbddc->mat_graph->coords = lcoords;
7119       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7120       pcbddc->mat_graph->cnloc  = n;
7121     }
7122     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);
7123     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7124 
7125     /* Setup of Graph */
7126     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7127     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7128 
7129     /* attach info on disconnected subdomains if present */
7130     if (pcbddc->n_local_subs) {
7131       PetscInt *local_subs,n,totn;
7132 
7133       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7134       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7135       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7136       for (i=0;i<pcbddc->n_local_subs;i++) {
7137         const PetscInt *idxs;
7138         PetscInt       nl,j;
7139 
7140         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7141         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7142         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7143         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7144       }
7145       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7146       pcbddc->mat_graph->n_local_subs = totn + 1;
7147       pcbddc->mat_graph->local_subs = local_subs;
7148     }
7149   }
7150 
7151   if (!pcbddc->graphanalyzed) {
7152     /* Graph's connected components analysis */
7153     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7154     pcbddc->graphanalyzed = PETSC_TRUE;
7155     pcbddc->corner_selected = pcbddc->corner_selection;
7156   }
7157   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7158   PetscFunctionReturn(0);
7159 }
7160 
7161 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7162 {
7163   PetscInt       i,j;
7164   PetscScalar    *alphas;
7165   PetscReal      norm;
7166   PetscErrorCode ierr;
7167 
7168   PetscFunctionBegin;
7169   if (!n) PetscFunctionReturn(0);
7170   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7171   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7172   if (norm < PETSC_SMALL) {
7173     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7174   }
7175   for (i=1;i<n;i++) {
7176     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7177     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7178     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7179     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7180     if (norm < PETSC_SMALL) {
7181       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7182     }
7183   }
7184   ierr = PetscFree(alphas);CHKERRQ(ierr);
7185   PetscFunctionReturn(0);
7186 }
7187 
7188 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7189 {
7190   Mat            A;
7191   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7192   PetscMPIInt    size,rank,color;
7193   PetscInt       *xadj,*adjncy;
7194   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7195   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7196   PetscInt       void_procs,*procs_candidates = NULL;
7197   PetscInt       xadj_count,*count;
7198   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7199   PetscSubcomm   psubcomm;
7200   MPI_Comm       subcomm;
7201   PetscErrorCode ierr;
7202 
7203   PetscFunctionBegin;
7204   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7205   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7206   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);
7207   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7208   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7209   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7210 
7211   if (have_void) *have_void = PETSC_FALSE;
7212   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7213   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7214   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7215   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7216   im_active = !!n;
7217   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7218   void_procs = size - active_procs;
7219   /* get ranks of of non-active processes in mat communicator */
7220   if (void_procs) {
7221     PetscInt ncand;
7222 
7223     if (have_void) *have_void = PETSC_TRUE;
7224     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7225     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7226     for (i=0,ncand=0;i<size;i++) {
7227       if (!procs_candidates[i]) {
7228         procs_candidates[ncand++] = i;
7229       }
7230     }
7231     /* force n_subdomains to be not greater that the number of non-active processes */
7232     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7233   }
7234 
7235   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7236      number of subdomains requested 1 -> send to master or first candidate in voids  */
7237   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7238   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7239     PetscInt issize,isidx,dest;
7240     if (*n_subdomains == 1) dest = 0;
7241     else dest = rank;
7242     if (im_active) {
7243       issize = 1;
7244       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7245         isidx = procs_candidates[dest];
7246       } else {
7247         isidx = dest;
7248       }
7249     } else {
7250       issize = 0;
7251       isidx = -1;
7252     }
7253     if (*n_subdomains != 1) *n_subdomains = active_procs;
7254     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7255     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7256     PetscFunctionReturn(0);
7257   }
7258   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7259   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7260   threshold = PetscMax(threshold,2);
7261 
7262   /* Get info on mapping */
7263   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7264 
7265   /* build local CSR graph of subdomains' connectivity */
7266   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7267   xadj[0] = 0;
7268   xadj[1] = PetscMax(n_neighs-1,0);
7269   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7270   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7271   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7272   for (i=1;i<n_neighs;i++)
7273     for (j=0;j<n_shared[i];j++)
7274       count[shared[i][j]] += 1;
7275 
7276   xadj_count = 0;
7277   for (i=1;i<n_neighs;i++) {
7278     for (j=0;j<n_shared[i];j++) {
7279       if (count[shared[i][j]] < threshold) {
7280         adjncy[xadj_count] = neighs[i];
7281         adjncy_wgt[xadj_count] = n_shared[i];
7282         xadj_count++;
7283         break;
7284       }
7285     }
7286   }
7287   xadj[1] = xadj_count;
7288   ierr = PetscFree(count);CHKERRQ(ierr);
7289   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7290   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7291 
7292   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7293 
7294   /* Restrict work on active processes only */
7295   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7296   if (void_procs) {
7297     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7298     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7299     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7300     subcomm = PetscSubcommChild(psubcomm);
7301   } else {
7302     psubcomm = NULL;
7303     subcomm = PetscObjectComm((PetscObject)mat);
7304   }
7305 
7306   v_wgt = NULL;
7307   if (!color) {
7308     ierr = PetscFree(xadj);CHKERRQ(ierr);
7309     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7310     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7311   } else {
7312     Mat             subdomain_adj;
7313     IS              new_ranks,new_ranks_contig;
7314     MatPartitioning partitioner;
7315     PetscInt        rstart=0,rend=0;
7316     PetscInt        *is_indices,*oldranks;
7317     PetscMPIInt     size;
7318     PetscBool       aggregate;
7319 
7320     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7321     if (void_procs) {
7322       PetscInt prank = rank;
7323       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7324       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7325       for (i=0;i<xadj[1];i++) {
7326         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7327       }
7328       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7329     } else {
7330       oldranks = NULL;
7331     }
7332     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7333     if (aggregate) { /* TODO: all this part could be made more efficient */
7334       PetscInt    lrows,row,ncols,*cols;
7335       PetscMPIInt nrank;
7336       PetscScalar *vals;
7337 
7338       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7339       lrows = 0;
7340       if (nrank<redprocs) {
7341         lrows = size/redprocs;
7342         if (nrank<size%redprocs) lrows++;
7343       }
7344       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7345       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7346       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7347       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7348       row = nrank;
7349       ncols = xadj[1]-xadj[0];
7350       cols = adjncy;
7351       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7352       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7353       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7354       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7355       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7356       ierr = PetscFree(xadj);CHKERRQ(ierr);
7357       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7358       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7359       ierr = PetscFree(vals);CHKERRQ(ierr);
7360       if (use_vwgt) {
7361         Vec               v;
7362         const PetscScalar *array;
7363         PetscInt          nl;
7364 
7365         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7366         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7367         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7368         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7369         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7370         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7371         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7372         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7373         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7374         ierr = VecDestroy(&v);CHKERRQ(ierr);
7375       }
7376     } else {
7377       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7378       if (use_vwgt) {
7379         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7380         v_wgt[0] = n;
7381       }
7382     }
7383     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7384 
7385     /* Partition */
7386     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7387 #if defined(PETSC_HAVE_PTSCOTCH)
7388     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7389 #elif defined(PETSC_HAVE_PARMETIS)
7390     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7391 #else
7392     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7393 #endif
7394     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7395     if (v_wgt) {
7396       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7397     }
7398     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7399     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7400     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7401     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7402     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7403 
7404     /* renumber new_ranks to avoid "holes" in new set of processors */
7405     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7406     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7407     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7408     if (!aggregate) {
7409       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7410 #if defined(PETSC_USE_DEBUG)
7411         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7412 #endif
7413         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7414       } else if (oldranks) {
7415         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7416       } else {
7417         ranks_send_to_idx[0] = is_indices[0];
7418       }
7419     } else {
7420       PetscInt    idx = 0;
7421       PetscMPIInt tag;
7422       MPI_Request *reqs;
7423 
7424       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7425       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7426       for (i=rstart;i<rend;i++) {
7427         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7428       }
7429       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7430       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7431       ierr = PetscFree(reqs);CHKERRQ(ierr);
7432       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7433 #if defined(PETSC_USE_DEBUG)
7434         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7435 #endif
7436         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7437       } else if (oldranks) {
7438         ranks_send_to_idx[0] = oldranks[idx];
7439       } else {
7440         ranks_send_to_idx[0] = idx;
7441       }
7442     }
7443     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7444     /* clean up */
7445     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7446     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7447     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7448     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7449   }
7450   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7451   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7452 
7453   /* assemble parallel IS for sends */
7454   i = 1;
7455   if (!color) i=0;
7456   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7457   PetscFunctionReturn(0);
7458 }
7459 
7460 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7461 
7462 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[])
7463 {
7464   Mat                    local_mat;
7465   IS                     is_sends_internal;
7466   PetscInt               rows,cols,new_local_rows;
7467   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7468   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7469   ISLocalToGlobalMapping l2gmap;
7470   PetscInt*              l2gmap_indices;
7471   const PetscInt*        is_indices;
7472   MatType                new_local_type;
7473   /* buffers */
7474   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7475   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7476   PetscInt               *recv_buffer_idxs_local;
7477   PetscScalar            *ptr_vals,*recv_buffer_vals;
7478   const PetscScalar      *send_buffer_vals;
7479   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7480   /* MPI */
7481   MPI_Comm               comm,comm_n;
7482   PetscSubcomm           subcomm;
7483   PetscMPIInt            n_sends,n_recvs,size;
7484   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7485   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7486   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7487   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7488   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7489   PetscErrorCode         ierr;
7490 
7491   PetscFunctionBegin;
7492   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7493   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7494   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);
7495   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7496   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7497   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7498   PetscValidLogicalCollectiveBool(mat,reuse,6);
7499   PetscValidLogicalCollectiveInt(mat,nis,8);
7500   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7501   if (nvecs) {
7502     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7503     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7504   }
7505   /* further checks */
7506   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7507   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7508   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7509   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7510   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7511   if (reuse && *mat_n) {
7512     PetscInt mrows,mcols,mnrows,mncols;
7513     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7514     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7515     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7516     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7517     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7518     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7519     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7520   }
7521   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7522   PetscValidLogicalCollectiveInt(mat,bs,0);
7523 
7524   /* prepare IS for sending if not provided */
7525   if (!is_sends) {
7526     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7527     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7528   } else {
7529     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7530     is_sends_internal = is_sends;
7531   }
7532 
7533   /* get comm */
7534   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7535 
7536   /* compute number of sends */
7537   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7538   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7539 
7540   /* compute number of receives */
7541   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7542   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7543   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7544   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7545   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7546   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7547   ierr = PetscFree(iflags);CHKERRQ(ierr);
7548 
7549   /* restrict comm if requested */
7550   subcomm = 0;
7551   destroy_mat = PETSC_FALSE;
7552   if (restrict_comm) {
7553     PetscMPIInt color,subcommsize;
7554 
7555     color = 0;
7556     if (restrict_full) {
7557       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7558     } else {
7559       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7560     }
7561     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7562     subcommsize = size - subcommsize;
7563     /* check if reuse has been requested */
7564     if (reuse) {
7565       if (*mat_n) {
7566         PetscMPIInt subcommsize2;
7567         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7568         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7569         comm_n = PetscObjectComm((PetscObject)*mat_n);
7570       } else {
7571         comm_n = PETSC_COMM_SELF;
7572       }
7573     } else { /* MAT_INITIAL_MATRIX */
7574       PetscMPIInt rank;
7575 
7576       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7577       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7578       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7579       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7580       comm_n = PetscSubcommChild(subcomm);
7581     }
7582     /* flag to destroy *mat_n if not significative */
7583     if (color) destroy_mat = PETSC_TRUE;
7584   } else {
7585     comm_n = comm;
7586   }
7587 
7588   /* prepare send/receive buffers */
7589   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7590   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7591   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7592   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7593   if (nis) {
7594     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7595   }
7596 
7597   /* Get data from local matrices */
7598   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7599     /* TODO: See below some guidelines on how to prepare the local buffers */
7600     /*
7601        send_buffer_vals should contain the raw values of the local matrix
7602        send_buffer_idxs should contain:
7603        - MatType_PRIVATE type
7604        - PetscInt        size_of_l2gmap
7605        - PetscInt        global_row_indices[size_of_l2gmap]
7606        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7607     */
7608   else {
7609     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7610     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7611     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7612     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7613     send_buffer_idxs[1] = i;
7614     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7615     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7616     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7617     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7618     for (i=0;i<n_sends;i++) {
7619       ilengths_vals[is_indices[i]] = len*len;
7620       ilengths_idxs[is_indices[i]] = len+2;
7621     }
7622   }
7623   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7624   /* additional is (if any) */
7625   if (nis) {
7626     PetscMPIInt psum;
7627     PetscInt j;
7628     for (j=0,psum=0;j<nis;j++) {
7629       PetscInt plen;
7630       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7631       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7632       psum += len+1; /* indices + lenght */
7633     }
7634     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7635     for (j=0,psum=0;j<nis;j++) {
7636       PetscInt plen;
7637       const PetscInt *is_array_idxs;
7638       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7639       send_buffer_idxs_is[psum] = plen;
7640       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7641       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7642       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7643       psum += plen+1; /* indices + lenght */
7644     }
7645     for (i=0;i<n_sends;i++) {
7646       ilengths_idxs_is[is_indices[i]] = psum;
7647     }
7648     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7649   }
7650   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7651 
7652   buf_size_idxs = 0;
7653   buf_size_vals = 0;
7654   buf_size_idxs_is = 0;
7655   buf_size_vecs = 0;
7656   for (i=0;i<n_recvs;i++) {
7657     buf_size_idxs += (PetscInt)olengths_idxs[i];
7658     buf_size_vals += (PetscInt)olengths_vals[i];
7659     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7660     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7661   }
7662   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7663   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7664   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7665   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7666 
7667   /* get new tags for clean communications */
7668   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7669   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7670   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7671   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7672 
7673   /* allocate for requests */
7674   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7675   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7676   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7677   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7678   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7679   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7680   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7681   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7682 
7683   /* communications */
7684   ptr_idxs = recv_buffer_idxs;
7685   ptr_vals = recv_buffer_vals;
7686   ptr_idxs_is = recv_buffer_idxs_is;
7687   ptr_vecs = recv_buffer_vecs;
7688   for (i=0;i<n_recvs;i++) {
7689     source_dest = onodes[i];
7690     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7691     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7692     ptr_idxs += olengths_idxs[i];
7693     ptr_vals += olengths_vals[i];
7694     if (nis) {
7695       source_dest = onodes_is[i];
7696       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);
7697       ptr_idxs_is += olengths_idxs_is[i];
7698     }
7699     if (nvecs) {
7700       source_dest = onodes[i];
7701       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7702       ptr_vecs += olengths_idxs[i]-2;
7703     }
7704   }
7705   for (i=0;i<n_sends;i++) {
7706     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7707     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7708     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7709     if (nis) {
7710       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);
7711     }
7712     if (nvecs) {
7713       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7714       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7715     }
7716   }
7717   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7718   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7719 
7720   /* assemble new l2g map */
7721   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7722   ptr_idxs = recv_buffer_idxs;
7723   new_local_rows = 0;
7724   for (i=0;i<n_recvs;i++) {
7725     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7726     ptr_idxs += olengths_idxs[i];
7727   }
7728   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7729   ptr_idxs = recv_buffer_idxs;
7730   new_local_rows = 0;
7731   for (i=0;i<n_recvs;i++) {
7732     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7733     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7734     ptr_idxs += olengths_idxs[i];
7735   }
7736   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7737   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7738   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7739 
7740   /* infer new local matrix type from received local matrices type */
7741   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7742   /* 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) */
7743   if (n_recvs) {
7744     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7745     ptr_idxs = recv_buffer_idxs;
7746     for (i=0;i<n_recvs;i++) {
7747       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7748         new_local_type_private = MATAIJ_PRIVATE;
7749         break;
7750       }
7751       ptr_idxs += olengths_idxs[i];
7752     }
7753     switch (new_local_type_private) {
7754       case MATDENSE_PRIVATE:
7755         new_local_type = MATSEQAIJ;
7756         bs = 1;
7757         break;
7758       case MATAIJ_PRIVATE:
7759         new_local_type = MATSEQAIJ;
7760         bs = 1;
7761         break;
7762       case MATBAIJ_PRIVATE:
7763         new_local_type = MATSEQBAIJ;
7764         break;
7765       case MATSBAIJ_PRIVATE:
7766         new_local_type = MATSEQSBAIJ;
7767         break;
7768       default:
7769         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7770         break;
7771     }
7772   } else { /* by default, new_local_type is seqaij */
7773     new_local_type = MATSEQAIJ;
7774     bs = 1;
7775   }
7776 
7777   /* create MATIS object if needed */
7778   if (!reuse) {
7779     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7780     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7781   } else {
7782     /* it also destroys the local matrices */
7783     if (*mat_n) {
7784       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7785     } else { /* this is a fake object */
7786       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7787     }
7788   }
7789   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7790   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7791 
7792   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7793 
7794   /* Global to local map of received indices */
7795   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7796   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7797   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7798 
7799   /* restore attributes -> type of incoming data and its size */
7800   buf_size_idxs = 0;
7801   for (i=0;i<n_recvs;i++) {
7802     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7803     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7804     buf_size_idxs += (PetscInt)olengths_idxs[i];
7805   }
7806   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7807 
7808   /* set preallocation */
7809   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7810   if (!newisdense) {
7811     PetscInt *new_local_nnz=0;
7812 
7813     ptr_idxs = recv_buffer_idxs_local;
7814     if (n_recvs) {
7815       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7816     }
7817     for (i=0;i<n_recvs;i++) {
7818       PetscInt j;
7819       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7820         for (j=0;j<*(ptr_idxs+1);j++) {
7821           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7822         }
7823       } else {
7824         /* TODO */
7825       }
7826       ptr_idxs += olengths_idxs[i];
7827     }
7828     if (new_local_nnz) {
7829       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7830       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7831       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7832       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7833       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7834       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7835     } else {
7836       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7837     }
7838     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7839   } else {
7840     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7841   }
7842 
7843   /* set values */
7844   ptr_vals = recv_buffer_vals;
7845   ptr_idxs = recv_buffer_idxs_local;
7846   for (i=0;i<n_recvs;i++) {
7847     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7848       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7849       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7850       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7851       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7852       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7853     } else {
7854       /* TODO */
7855     }
7856     ptr_idxs += olengths_idxs[i];
7857     ptr_vals += olengths_vals[i];
7858   }
7859   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7860   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7861   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7862   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7863   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7864   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7865 
7866 #if 0
7867   if (!restrict_comm) { /* check */
7868     Vec       lvec,rvec;
7869     PetscReal infty_error;
7870 
7871     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7872     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7873     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7874     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7875     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7876     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7877     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7878     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7879     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7880   }
7881 #endif
7882 
7883   /* assemble new additional is (if any) */
7884   if (nis) {
7885     PetscInt **temp_idxs,*count_is,j,psum;
7886 
7887     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7888     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7889     ptr_idxs = recv_buffer_idxs_is;
7890     psum = 0;
7891     for (i=0;i<n_recvs;i++) {
7892       for (j=0;j<nis;j++) {
7893         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7894         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7895         psum += plen;
7896         ptr_idxs += plen+1; /* shift pointer to received data */
7897       }
7898     }
7899     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7900     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7901     for (i=1;i<nis;i++) {
7902       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7903     }
7904     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
7905     ptr_idxs = recv_buffer_idxs_is;
7906     for (i=0;i<n_recvs;i++) {
7907       for (j=0;j<nis;j++) {
7908         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7909         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
7910         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7911         ptr_idxs += plen+1; /* shift pointer to received data */
7912       }
7913     }
7914     for (i=0;i<nis;i++) {
7915       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7916       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7917       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7918     }
7919     ierr = PetscFree(count_is);CHKERRQ(ierr);
7920     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7921     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7922   }
7923   /* free workspace */
7924   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7925   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7926   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7927   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7928   if (isdense) {
7929     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7930     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7931     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7932   } else {
7933     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7934   }
7935   if (nis) {
7936     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7937     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7938   }
7939 
7940   if (nvecs) {
7941     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7942     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7943     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7944     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7945     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7946     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7947     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7948     /* set values */
7949     ptr_vals = recv_buffer_vecs;
7950     ptr_idxs = recv_buffer_idxs_local;
7951     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7952     for (i=0;i<n_recvs;i++) {
7953       PetscInt j;
7954       for (j=0;j<*(ptr_idxs+1);j++) {
7955         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7956       }
7957       ptr_idxs += olengths_idxs[i];
7958       ptr_vals += olengths_idxs[i]-2;
7959     }
7960     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7961     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7962     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7963   }
7964 
7965   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7966   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7967   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7968   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7969   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7970   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7971   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7972   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7973   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7974   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7975   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7976   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7977   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7978   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7979   ierr = PetscFree(onodes);CHKERRQ(ierr);
7980   if (nis) {
7981     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7982     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7983     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7984   }
7985   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7986   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7987     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7988     for (i=0;i<nis;i++) {
7989       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7990     }
7991     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7992       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7993     }
7994     *mat_n = NULL;
7995   }
7996   PetscFunctionReturn(0);
7997 }
7998 
7999 /* temporary hack into ksp private data structure */
8000 #include <petsc/private/kspimpl.h>
8001 
8002 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8003 {
8004   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8005   PC_IS                  *pcis = (PC_IS*)pc->data;
8006   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8007   Mat                    coarsedivudotp = NULL;
8008   Mat                    coarseG,t_coarse_mat_is;
8009   MatNullSpace           CoarseNullSpace = NULL;
8010   ISLocalToGlobalMapping coarse_islg;
8011   IS                     coarse_is,*isarray,corners;
8012   PetscInt               i,im_active=-1,active_procs=-1;
8013   PetscInt               nis,nisdofs,nisneu,nisvert;
8014   PetscInt               coarse_eqs_per_proc;
8015   PC                     pc_temp;
8016   PCType                 coarse_pc_type;
8017   KSPType                coarse_ksp_type;
8018   PetscBool              multilevel_requested,multilevel_allowed;
8019   PetscBool              coarse_reuse;
8020   PetscInt               ncoarse,nedcfield;
8021   PetscBool              compute_vecs = PETSC_FALSE;
8022   PetscScalar            *array;
8023   MatReuse               coarse_mat_reuse;
8024   PetscBool              restr, full_restr, have_void;
8025   PetscMPIInt            size;
8026   PetscErrorCode         ierr;
8027 
8028   PetscFunctionBegin;
8029   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8030   /* Assign global numbering to coarse dofs */
8031   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 */
8032     PetscInt ocoarse_size;
8033     compute_vecs = PETSC_TRUE;
8034 
8035     pcbddc->new_primal_space = PETSC_TRUE;
8036     ocoarse_size = pcbddc->coarse_size;
8037     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8038     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8039     /* see if we can avoid some work */
8040     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8041       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8042       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8043         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8044         coarse_reuse = PETSC_FALSE;
8045       } else { /* we can safely reuse already computed coarse matrix */
8046         coarse_reuse = PETSC_TRUE;
8047       }
8048     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8049       coarse_reuse = PETSC_FALSE;
8050     }
8051     /* reset any subassembling information */
8052     if (!coarse_reuse || pcbddc->recompute_topography) {
8053       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8054     }
8055   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8056     coarse_reuse = PETSC_TRUE;
8057   }
8058   if (coarse_reuse && pcbddc->coarse_ksp) {
8059     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8060     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8061     coarse_mat_reuse = MAT_REUSE_MATRIX;
8062   } else {
8063     coarse_mat = NULL;
8064     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8065   }
8066 
8067   /* creates temporary l2gmap and IS for coarse indexes */
8068   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8069   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8070 
8071   /* creates temporary MATIS object for coarse matrix */
8072   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8073   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);
8074   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8075   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8076   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8077   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8078 
8079   /* count "active" (i.e. with positive local size) and "void" processes */
8080   im_active = !!(pcis->n);
8081   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8082 
8083   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8084   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8085   /* full_restr : just use the receivers from the subassembling pattern */
8086   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8087   coarse_mat_is        = NULL;
8088   multilevel_allowed   = PETSC_FALSE;
8089   multilevel_requested = PETSC_FALSE;
8090   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8091   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8092   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8093   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8094   if (multilevel_requested) {
8095     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8096     restr      = PETSC_FALSE;
8097     full_restr = PETSC_FALSE;
8098   } else {
8099     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8100     restr      = PETSC_TRUE;
8101     full_restr = PETSC_TRUE;
8102   }
8103   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8104   ncoarse = PetscMax(1,ncoarse);
8105   if (!pcbddc->coarse_subassembling) {
8106     if (pcbddc->coarsening_ratio > 1) {
8107       if (multilevel_requested) {
8108         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8109       } else {
8110         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8111       }
8112     } else {
8113       PetscMPIInt rank;
8114       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8115       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8116       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8117     }
8118   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8119     PetscInt    psum;
8120     if (pcbddc->coarse_ksp) psum = 1;
8121     else psum = 0;
8122     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8123     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8124   }
8125   /* determine if we can go multilevel */
8126   if (multilevel_requested) {
8127     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8128     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8129   }
8130   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8131 
8132   /* dump subassembling pattern */
8133   if (pcbddc->dbg_flag && multilevel_allowed) {
8134     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8135   }
8136   /* compute dofs splitting and neumann boundaries for coarse dofs */
8137   nedcfield = -1;
8138   corners = NULL;
8139   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8140     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8141     const PetscInt         *idxs;
8142     ISLocalToGlobalMapping tmap;
8143 
8144     /* create map between primal indices (in local representative ordering) and local primal numbering */
8145     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8146     /* allocate space for temporary storage */
8147     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8148     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8149     /* allocate for IS array */
8150     nisdofs = pcbddc->n_ISForDofsLocal;
8151     if (pcbddc->nedclocal) {
8152       if (pcbddc->nedfield > -1) {
8153         nedcfield = pcbddc->nedfield;
8154       } else {
8155         nedcfield = 0;
8156         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8157         nisdofs = 1;
8158       }
8159     }
8160     nisneu = !!pcbddc->NeumannBoundariesLocal;
8161     nisvert = 0; /* nisvert is not used */
8162     nis = nisdofs + nisneu + nisvert;
8163     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8164     /* dofs splitting */
8165     for (i=0;i<nisdofs;i++) {
8166       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8167       if (nedcfield != i) {
8168         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8169         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8170         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8171         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8172       } else {
8173         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8174         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8175         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8176         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8177         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8178       }
8179       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8180       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8181       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8182     }
8183     /* neumann boundaries */
8184     if (pcbddc->NeumannBoundariesLocal) {
8185       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8186       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8187       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8188       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8189       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8190       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8191       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8192       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8193     }
8194     /* coordinates */
8195     if (pcbddc->corner_selected) {
8196       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8197       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8198       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8199       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8200       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8201       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8202       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8203       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8204       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8205     }
8206     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8207     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8208     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8209   } else {
8210     nis = 0;
8211     nisdofs = 0;
8212     nisneu = 0;
8213     nisvert = 0;
8214     isarray = NULL;
8215   }
8216   /* destroy no longer needed map */
8217   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8218 
8219   /* subassemble */
8220   if (multilevel_allowed) {
8221     Vec       vp[1];
8222     PetscInt  nvecs = 0;
8223     PetscBool reuse,reuser;
8224 
8225     if (coarse_mat) reuse = PETSC_TRUE;
8226     else reuse = PETSC_FALSE;
8227     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8228     vp[0] = NULL;
8229     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8230       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8231       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8232       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8233       nvecs = 1;
8234 
8235       if (pcbddc->divudotp) {
8236         Mat      B,loc_divudotp;
8237         Vec      v,p;
8238         IS       dummy;
8239         PetscInt np;
8240 
8241         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8242         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8243         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8244         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8245         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8246         ierr = VecSet(p,1.);CHKERRQ(ierr);
8247         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8248         ierr = VecDestroy(&p);CHKERRQ(ierr);
8249         ierr = MatDestroy(&B);CHKERRQ(ierr);
8250         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8251         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8252         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8253         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8254         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8255         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8256         ierr = VecDestroy(&v);CHKERRQ(ierr);
8257       }
8258     }
8259     if (reuser) {
8260       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8261     } else {
8262       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8263     }
8264     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8265       PetscScalar       *arraym;
8266       const PetscScalar *arrayv;
8267       PetscInt          nl;
8268       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8269       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8270       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8271       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8272       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8273       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8274       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8275       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8276     } else {
8277       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8278     }
8279   } else {
8280     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8281   }
8282   if (coarse_mat_is || coarse_mat) {
8283     if (!multilevel_allowed) {
8284       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8285     } else {
8286       Mat A;
8287 
8288       /* if this matrix is present, it means we are not reusing the coarse matrix */
8289       if (coarse_mat_is) {
8290         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8291         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8292         coarse_mat = coarse_mat_is;
8293       }
8294       /* be sure we don't have MatSeqDENSE as local mat */
8295       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8296       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8297     }
8298   }
8299   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8300   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8301 
8302   /* create local to global scatters for coarse problem */
8303   if (compute_vecs) {
8304     PetscInt lrows;
8305     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8306     if (coarse_mat) {
8307       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8308     } else {
8309       lrows = 0;
8310     }
8311     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8312     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8313     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8314     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8315     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8316   }
8317   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8318 
8319   /* set defaults for coarse KSP and PC */
8320   if (multilevel_allowed) {
8321     coarse_ksp_type = KSPRICHARDSON;
8322     coarse_pc_type  = PCBDDC;
8323   } else {
8324     coarse_ksp_type = KSPPREONLY;
8325     coarse_pc_type  = PCREDUNDANT;
8326   }
8327 
8328   /* print some info if requested */
8329   if (pcbddc->dbg_flag) {
8330     if (!multilevel_allowed) {
8331       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8332       if (multilevel_requested) {
8333         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);
8334       } else if (pcbddc->max_levels) {
8335         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8336       }
8337       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8338     }
8339   }
8340 
8341   /* communicate coarse discrete gradient */
8342   coarseG = NULL;
8343   if (pcbddc->nedcG && multilevel_allowed) {
8344     MPI_Comm ccomm;
8345     if (coarse_mat) {
8346       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8347     } else {
8348       ccomm = MPI_COMM_NULL;
8349     }
8350     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8351   }
8352 
8353   /* create the coarse KSP object only once with defaults */
8354   if (coarse_mat) {
8355     PetscBool   isredundant,isnn,isbddc;
8356     PetscViewer dbg_viewer = NULL;
8357 
8358     if (pcbddc->dbg_flag) {
8359       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8360       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8361     }
8362     if (!pcbddc->coarse_ksp) {
8363       char   prefix[256],str_level[16];
8364       size_t len;
8365 
8366       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8367       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8368       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8369       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8370       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8371       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8372       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8373       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8374       /* TODO is this logic correct? should check for coarse_mat type */
8375       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8376       /* prefix */
8377       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8378       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8379       if (!pcbddc->current_level) {
8380         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8381         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8382       } else {
8383         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8384         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8385         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8386         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8387         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8388         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8389         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8390       }
8391       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8392       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8393       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8394       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8395       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8396       /* allow user customization */
8397       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8398       /* get some info after set from options */
8399       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8400       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8401       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8402       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8403       if (multilevel_allowed && !isbddc && !isnn) {
8404         isbddc = PETSC_TRUE;
8405         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8406         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8407         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8408         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8409         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8410           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8411           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8412           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8413           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8414           pc_temp->setfromoptionscalled++;
8415         }
8416       }
8417     }
8418     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8419     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8420     if (nisdofs) {
8421       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8422       for (i=0;i<nisdofs;i++) {
8423         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8424       }
8425     }
8426     if (nisneu) {
8427       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8428       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8429     }
8430     if (nisvert) {
8431       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8432       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8433     }
8434     if (coarseG) {
8435       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8436     }
8437 
8438     /* get some info after set from options */
8439     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8440 
8441     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8442     if (isbddc && !multilevel_allowed) {
8443       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8444       isbddc = PETSC_FALSE;
8445     }
8446     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8447     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8448     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8449       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8450       isbddc = PETSC_TRUE;
8451     }
8452     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8453     if (isredundant) {
8454       KSP inner_ksp;
8455       PC  inner_pc;
8456 
8457       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8458       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8459     }
8460 
8461     /* parameters which miss an API */
8462     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8463     if (isbddc) {
8464       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8465 
8466       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8467       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8468       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8469       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8470       if (pcbddc_coarse->benign_saddle_point) {
8471         Mat                    coarsedivudotp_is;
8472         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8473         IS                     row,col;
8474         const PetscInt         *gidxs;
8475         PetscInt               n,st,M,N;
8476 
8477         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8478         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8479         st   = st-n;
8480         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8481         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8482         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8483         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8484         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8485         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8486         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8487         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8488         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8489         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8490         ierr = ISDestroy(&row);CHKERRQ(ierr);
8491         ierr = ISDestroy(&col);CHKERRQ(ierr);
8492         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8493         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8494         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8495         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8496         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8497         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8498         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8499         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8500         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8501         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8502         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8503         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8504       }
8505     }
8506 
8507     /* propagate symmetry info of coarse matrix */
8508     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8509     if (pc->pmat->symmetric_set) {
8510       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8511     }
8512     if (pc->pmat->hermitian_set) {
8513       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8514     }
8515     if (pc->pmat->spd_set) {
8516       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8517     }
8518     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8519       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8520     }
8521     /* set operators */
8522     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8523     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8524     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8525     if (pcbddc->dbg_flag) {
8526       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8527     }
8528   }
8529   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8530   ierr = PetscFree(isarray);CHKERRQ(ierr);
8531 #if 0
8532   {
8533     PetscViewer viewer;
8534     char filename[256];
8535     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8536     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8537     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8538     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8539     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8540     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8541   }
8542 #endif
8543 
8544   if (corners) {
8545     Vec            gv;
8546     IS             is;
8547     const PetscInt *idxs;
8548     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8549     PetscScalar    *coords;
8550 
8551     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8552     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8553     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8554     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8555     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8556     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8557     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8558     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8559     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8560 
8561     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8562     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8563     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8564     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8565     for (i=0;i<n;i++) {
8566       for (d=0;d<cdim;d++) {
8567         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8568       }
8569     }
8570     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8571     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8572 
8573     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8574     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8575     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8576     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8577     ierr = PetscFree(coords);CHKERRQ(ierr);
8578     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8579     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8580     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8581     if (pcbddc->coarse_ksp) {
8582       PC        coarse_pc;
8583       PetscBool isbddc;
8584 
8585       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8586       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8587       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8588         PetscReal *realcoords;
8589 
8590         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8591 #if defined(PETSC_USE_COMPLEX)
8592         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8593         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8594 #else
8595         realcoords = coords;
8596 #endif
8597         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8598 #if defined(PETSC_USE_COMPLEX)
8599         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8600 #endif
8601       }
8602     }
8603     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8604     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8605   }
8606   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8607 
8608   if (pcbddc->coarse_ksp) {
8609     Vec crhs,csol;
8610 
8611     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8612     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8613     if (!csol) {
8614       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8615     }
8616     if (!crhs) {
8617       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8618     }
8619   }
8620   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8621 
8622   /* compute null space for coarse solver if the benign trick has been requested */
8623   if (pcbddc->benign_null) {
8624 
8625     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8626     for (i=0;i<pcbddc->benign_n;i++) {
8627       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8628     }
8629     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8630     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8631     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8632     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8633     if (coarse_mat) {
8634       Vec         nullv;
8635       PetscScalar *array,*array2;
8636       PetscInt    nl;
8637 
8638       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8639       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8640       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8641       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8642       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8643       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8644       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8645       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8646       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8647       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8648     }
8649   }
8650   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8651 
8652   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8653   if (pcbddc->coarse_ksp) {
8654     PetscBool ispreonly;
8655 
8656     if (CoarseNullSpace) {
8657       PetscBool isnull;
8658       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8659       if (isnull) {
8660         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8661       }
8662       /* TODO: add local nullspaces (if any) */
8663     }
8664     /* setup coarse ksp */
8665     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8666     /* Check coarse problem if in debug mode or if solving with an iterative method */
8667     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8668     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8669       KSP       check_ksp;
8670       KSPType   check_ksp_type;
8671       PC        check_pc;
8672       Vec       check_vec,coarse_vec;
8673       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8674       PetscInt  its;
8675       PetscBool compute_eigs;
8676       PetscReal *eigs_r,*eigs_c;
8677       PetscInt  neigs;
8678       const char *prefix;
8679 
8680       /* Create ksp object suitable for estimation of extreme eigenvalues */
8681       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8682       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8683       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8684       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8685       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8686       /* prevent from setup unneeded object */
8687       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8688       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8689       if (ispreonly) {
8690         check_ksp_type = KSPPREONLY;
8691         compute_eigs = PETSC_FALSE;
8692       } else {
8693         check_ksp_type = KSPGMRES;
8694         compute_eigs = PETSC_TRUE;
8695       }
8696       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8697       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8698       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8699       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8700       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8701       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8702       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8703       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8704       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8705       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8706       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8707       /* create random vec */
8708       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8709       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8710       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8711       /* solve coarse problem */
8712       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8713       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8714       /* set eigenvalue estimation if preonly has not been requested */
8715       if (compute_eigs) {
8716         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8717         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8718         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8719         if (neigs) {
8720           lambda_max = eigs_r[neigs-1];
8721           lambda_min = eigs_r[0];
8722           if (pcbddc->use_coarse_estimates) {
8723             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8724               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8725               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8726             }
8727           }
8728         }
8729       }
8730 
8731       /* check coarse problem residual error */
8732       if (pcbddc->dbg_flag) {
8733         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8734         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8735         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8736         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8737         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8738         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8739         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8740         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8741         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8742         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8743         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8744         if (CoarseNullSpace) {
8745           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8746         }
8747         if (compute_eigs) {
8748           PetscReal          lambda_max_s,lambda_min_s;
8749           KSPConvergedReason reason;
8750           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8751           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8752           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8753           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8754           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);
8755           for (i=0;i<neigs;i++) {
8756             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8757           }
8758         }
8759         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8760         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8761       }
8762       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8763       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8764       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8765       if (compute_eigs) {
8766         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8767         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8768       }
8769     }
8770   }
8771   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8772   /* print additional info */
8773   if (pcbddc->dbg_flag) {
8774     /* waits until all processes reaches this point */
8775     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8776     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8777     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8778   }
8779 
8780   /* free memory */
8781   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8782   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8783   PetscFunctionReturn(0);
8784 }
8785 
8786 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8787 {
8788   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8789   PC_IS*         pcis = (PC_IS*)pc->data;
8790   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8791   IS             subset,subset_mult,subset_n;
8792   PetscInt       local_size,coarse_size=0;
8793   PetscInt       *local_primal_indices=NULL;
8794   const PetscInt *t_local_primal_indices;
8795   PetscErrorCode ierr;
8796 
8797   PetscFunctionBegin;
8798   /* Compute global number of coarse dofs */
8799   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8800   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8801   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8802   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8803   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8804   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8805   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8806   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8807   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8808   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);
8809   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8810   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8811   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8812   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8813   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8814 
8815   /* check numbering */
8816   if (pcbddc->dbg_flag) {
8817     PetscScalar coarsesum,*array,*array2;
8818     PetscInt    i;
8819     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8820 
8821     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8822     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8823     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8824     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8825     /* counter */
8826     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8827     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8828     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8829     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8830     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8831     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8832     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8833     for (i=0;i<pcbddc->local_primal_size;i++) {
8834       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8835     }
8836     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8837     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8838     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8839     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8840     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8841     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8842     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8843     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8844     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8845     for (i=0;i<pcis->n;i++) {
8846       if (array[i] != 0.0 && array[i] != array2[i]) {
8847         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8848         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8849         set_error = PETSC_TRUE;
8850         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8851         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);
8852       }
8853     }
8854     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8855     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8856     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8857     for (i=0;i<pcis->n;i++) {
8858       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8859     }
8860     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8861     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8862     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8863     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8864     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8865     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8866     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8867       PetscInt *gidxs;
8868 
8869       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8870       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8871       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8872       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8873       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8874       for (i=0;i<pcbddc->local_primal_size;i++) {
8875         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);
8876       }
8877       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8878       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8879     }
8880     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8881     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8882     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8883   }
8884 
8885   /* get back data */
8886   *coarse_size_n = coarse_size;
8887   *local_primal_indices_n = local_primal_indices;
8888   PetscFunctionReturn(0);
8889 }
8890 
8891 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8892 {
8893   IS             localis_t;
8894   PetscInt       i,lsize,*idxs,n;
8895   PetscScalar    *vals;
8896   PetscErrorCode ierr;
8897 
8898   PetscFunctionBegin;
8899   /* get indices in local ordering exploiting local to global map */
8900   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8901   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8902   for (i=0;i<lsize;i++) vals[i] = 1.0;
8903   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8904   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8905   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8906   if (idxs) { /* multilevel guard */
8907     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8908     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8909   }
8910   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8911   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8912   ierr = PetscFree(vals);CHKERRQ(ierr);
8913   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8914   /* now compute set in local ordering */
8915   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8916   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8917   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8918   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8919   for (i=0,lsize=0;i<n;i++) {
8920     if (PetscRealPart(vals[i]) > 0.5) {
8921       lsize++;
8922     }
8923   }
8924   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8925   for (i=0,lsize=0;i<n;i++) {
8926     if (PetscRealPart(vals[i]) > 0.5) {
8927       idxs[lsize++] = i;
8928     }
8929   }
8930   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8931   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8932   *localis = localis_t;
8933   PetscFunctionReturn(0);
8934 }
8935 
8936 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8937 {
8938   PC_IS               *pcis=(PC_IS*)pc->data;
8939   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8940   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8941   Mat                 S_j;
8942   PetscInt            *used_xadj,*used_adjncy;
8943   PetscBool           free_used_adj;
8944   PetscErrorCode      ierr;
8945 
8946   PetscFunctionBegin;
8947   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8948   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8949   free_used_adj = PETSC_FALSE;
8950   if (pcbddc->sub_schurs_layers == -1) {
8951     used_xadj = NULL;
8952     used_adjncy = NULL;
8953   } else {
8954     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8955       used_xadj = pcbddc->mat_graph->xadj;
8956       used_adjncy = pcbddc->mat_graph->adjncy;
8957     } else if (pcbddc->computed_rowadj) {
8958       used_xadj = pcbddc->mat_graph->xadj;
8959       used_adjncy = pcbddc->mat_graph->adjncy;
8960     } else {
8961       PetscBool      flg_row=PETSC_FALSE;
8962       const PetscInt *xadj,*adjncy;
8963       PetscInt       nvtxs;
8964 
8965       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8966       if (flg_row) {
8967         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8968         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
8969         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
8970         free_used_adj = PETSC_TRUE;
8971       } else {
8972         pcbddc->sub_schurs_layers = -1;
8973         used_xadj = NULL;
8974         used_adjncy = NULL;
8975       }
8976       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8977     }
8978   }
8979 
8980   /* setup sub_schurs data */
8981   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8982   if (!sub_schurs->schur_explicit) {
8983     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8984     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8985     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);
8986   } else {
8987     Mat       change = NULL;
8988     Vec       scaling = NULL;
8989     IS        change_primal = NULL, iP;
8990     PetscInt  benign_n;
8991     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8992     PetscBool isseqaij,need_change = PETSC_FALSE;
8993     PetscBool discrete_harmonic = PETSC_FALSE;
8994 
8995     if (!pcbddc->use_vertices && reuse_solvers) {
8996       PetscInt n_vertices;
8997 
8998       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8999       reuse_solvers = (PetscBool)!n_vertices;
9000     }
9001     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
9002     if (!isseqaij) {
9003       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
9004       if (matis->A == pcbddc->local_mat) {
9005         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
9006         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9007       } else {
9008         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9009       }
9010     }
9011     if (!pcbddc->benign_change_explicit) {
9012       benign_n = pcbddc->benign_n;
9013     } else {
9014       benign_n = 0;
9015     }
9016     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9017        We need a global reduction to avoid possible deadlocks.
9018        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9019     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9020       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9021       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9022       need_change = (PetscBool)(!need_change);
9023     }
9024     /* If the user defines additional constraints, we import them here.
9025        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 */
9026     if (need_change) {
9027       PC_IS   *pcisf;
9028       PC_BDDC *pcbddcf;
9029       PC      pcf;
9030 
9031       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9032       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9033       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9034       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9035 
9036       /* hacks */
9037       pcisf                        = (PC_IS*)pcf->data;
9038       pcisf->is_B_local            = pcis->is_B_local;
9039       pcisf->vec1_N                = pcis->vec1_N;
9040       pcisf->BtoNmap               = pcis->BtoNmap;
9041       pcisf->n                     = pcis->n;
9042       pcisf->n_B                   = pcis->n_B;
9043       pcbddcf                      = (PC_BDDC*)pcf->data;
9044       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9045       pcbddcf->mat_graph           = pcbddc->mat_graph;
9046       pcbddcf->use_faces           = PETSC_TRUE;
9047       pcbddcf->use_change_of_basis = PETSC_TRUE;
9048       pcbddcf->use_change_on_faces = PETSC_TRUE;
9049       pcbddcf->use_qr_single       = PETSC_TRUE;
9050       pcbddcf->fake_change         = PETSC_TRUE;
9051 
9052       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9053       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9054       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9055       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9056       change = pcbddcf->ConstraintMatrix;
9057       pcbddcf->ConstraintMatrix = NULL;
9058 
9059       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9060       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9061       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9062       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9063       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9064       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9065       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9066       pcf->ops->destroy = NULL;
9067       pcf->ops->reset   = NULL;
9068       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9069     }
9070     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9071 
9072     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9073     if (iP) {
9074       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9075       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9076       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9077     }
9078     if (discrete_harmonic) {
9079       Mat A;
9080       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9081       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9082       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9083       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);
9084       ierr = MatDestroy(&A);CHKERRQ(ierr);
9085     } else {
9086       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);
9087     }
9088     ierr = MatDestroy(&change);CHKERRQ(ierr);
9089     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9090   }
9091   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9092 
9093   /* free adjacency */
9094   if (free_used_adj) {
9095     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9096   }
9097   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9098   PetscFunctionReturn(0);
9099 }
9100 
9101 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9102 {
9103   PC_IS               *pcis=(PC_IS*)pc->data;
9104   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9105   PCBDDCGraph         graph;
9106   PetscErrorCode      ierr;
9107 
9108   PetscFunctionBegin;
9109   /* attach interface graph for determining subsets */
9110   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9111     IS       verticesIS,verticescomm;
9112     PetscInt vsize,*idxs;
9113 
9114     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9115     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9116     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9117     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9118     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9119     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9120     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9121     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9122     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9123     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9124     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9125   } else {
9126     graph = pcbddc->mat_graph;
9127   }
9128   /* print some info */
9129   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9130     IS       vertices;
9131     PetscInt nv,nedges,nfaces;
9132     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9133     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9134     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9135     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9136     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9137     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9138     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9139     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9140     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9141     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9142     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9143   }
9144 
9145   /* sub_schurs init */
9146   if (!pcbddc->sub_schurs) {
9147     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9148   }
9149   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);
9150 
9151   /* free graph struct */
9152   if (pcbddc->sub_schurs_rebuild) {
9153     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9154   }
9155   PetscFunctionReturn(0);
9156 }
9157 
9158 PetscErrorCode PCBDDCCheckOperator(PC pc)
9159 {
9160   PC_IS               *pcis=(PC_IS*)pc->data;
9161   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9162   PetscErrorCode      ierr;
9163 
9164   PetscFunctionBegin;
9165   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9166     IS             zerodiag = NULL;
9167     Mat            S_j,B0_B=NULL;
9168     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9169     PetscScalar    *p0_check,*array,*array2;
9170     PetscReal      norm;
9171     PetscInt       i;
9172 
9173     /* B0 and B0_B */
9174     if (zerodiag) {
9175       IS       dummy;
9176 
9177       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9178       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9179       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9180       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9181     }
9182     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9183     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9184     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9185     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9186     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9187     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9188     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9189     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9190     /* S_j */
9191     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9192     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9193 
9194     /* mimic vector in \widetilde{W}_\Gamma */
9195     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9196     /* continuous in primal space */
9197     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9198     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9199     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9200     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9201     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9202     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9203     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9204     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9205     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9206     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9207     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9208     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9209     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9210     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9211 
9212     /* assemble rhs for coarse problem */
9213     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9214     /* local with Schur */
9215     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9216     if (zerodiag) {
9217       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9218       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9219       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9220       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9221     }
9222     /* sum on primal nodes the local contributions */
9223     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9224     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9225     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9226     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9227     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9228     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9229     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9230     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9231     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9232     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9233     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9234     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9235     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9236     /* scale primal nodes (BDDC sums contibutions) */
9237     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9238     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9239     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9240     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9241     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9242     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9243     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9244     /* global: \widetilde{B0}_B w_\Gamma */
9245     if (zerodiag) {
9246       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9247       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9248       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9249       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9250     }
9251     /* BDDC */
9252     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9253     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9254 
9255     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9256     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9257     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9258     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9259     for (i=0;i<pcbddc->benign_n;i++) {
9260       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);
9261     }
9262     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9263     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9264     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9265     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9266     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9267     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9268   }
9269   PetscFunctionReturn(0);
9270 }
9271 
9272 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9273 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9274 {
9275   Mat            At;
9276   IS             rows;
9277   PetscInt       rst,ren;
9278   PetscErrorCode ierr;
9279   PetscLayout    rmap;
9280 
9281   PetscFunctionBegin;
9282   rst = ren = 0;
9283   if (ccomm != MPI_COMM_NULL) {
9284     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9285     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9286     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9287     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9288     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9289   }
9290   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9291   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9292   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9293 
9294   if (ccomm != MPI_COMM_NULL) {
9295     Mat_MPIAIJ *a,*b;
9296     IS         from,to;
9297     Vec        gvec;
9298     PetscInt   lsize;
9299 
9300     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9301     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9302     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9303     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9304     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9305     a    = (Mat_MPIAIJ*)At->data;
9306     b    = (Mat_MPIAIJ*)(*B)->data;
9307     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9308     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9309     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9310     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9311     b->A = a->A;
9312     b->B = a->B;
9313 
9314     b->donotstash      = a->donotstash;
9315     b->roworiented     = a->roworiented;
9316     b->rowindices      = 0;
9317     b->rowvalues       = 0;
9318     b->getrowactive    = PETSC_FALSE;
9319 
9320     (*B)->rmap         = rmap;
9321     (*B)->factortype   = A->factortype;
9322     (*B)->assembled    = PETSC_TRUE;
9323     (*B)->insertmode   = NOT_SET_VALUES;
9324     (*B)->preallocated = PETSC_TRUE;
9325 
9326     if (a->colmap) {
9327 #if defined(PETSC_USE_CTABLE)
9328       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9329 #else
9330       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9331       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9332       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9333 #endif
9334     } else b->colmap = 0;
9335     if (a->garray) {
9336       PetscInt len;
9337       len  = a->B->cmap->n;
9338       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9339       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9340       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9341     } else b->garray = 0;
9342 
9343     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9344     b->lvec = a->lvec;
9345     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9346 
9347     /* cannot use VecScatterCopy */
9348     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9349     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9350     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9351     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9352     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9353     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9354     ierr = ISDestroy(&from);CHKERRQ(ierr);
9355     ierr = ISDestroy(&to);CHKERRQ(ierr);
9356     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9357   }
9358   ierr = MatDestroy(&At);CHKERRQ(ierr);
9359   PetscFunctionReturn(0);
9360 }
9361