xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 5a856986583887c326abe5dfd149e8184a29cd80)
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 = DMGetSection(dm,&section);CHKERRQ(ierr);
1822       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1823       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1824       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1825       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1826       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1827       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1828       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1829       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1830       for (d=0;d<cdim;d++) {
1831         PetscInt          i;
1832         const PetscScalar *v;
1833 
1834         for (i=0;i<nf;i++) ctxs[i][0] = d;
1835         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1836         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1837         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1838         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1839       }
1840       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1841       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1842       ierr = PetscFree(coords);CHKERRQ(ierr);
1843       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1844       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1845     }
1846   }
1847   PetscFunctionReturn(0);
1848 }
1849 
1850 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1851 {
1852   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1853   PetscErrorCode  ierr;
1854   IS              nis;
1855   const PetscInt  *idxs;
1856   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1857   PetscBool       *ld;
1858 
1859   PetscFunctionBegin;
1860   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1861   if (mop == MPI_LAND) {
1862     /* init rootdata with true */
1863     ld   = (PetscBool*) matis->sf_rootdata;
1864     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1865   } else {
1866     ierr = 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 
3913   /* some shortcuts to scalars */
3914   PetscScalar     one=1.0,m_one=-1.0;
3915 
3916   PetscFunctionBegin;
3917   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");
3918   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3919 
3920   /* Set Non-overlapping dimensions */
3921   n_vertices = pcbddc->n_vertices;
3922   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3923   n_B = pcis->n_B;
3924   n_D = pcis->n - n_B;
3925   n_R = pcis->n - n_vertices;
3926 
3927   /* vertices in boundary numbering */
3928   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3929   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3930   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3931 
3932   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3933   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3934   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3935   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3936   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3937   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3938   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3939   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3940   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3941   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3942 
3943   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3944   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3945   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3946   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3947   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3948   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3949   lda_rhs = n_R;
3950   need_benign_correction = PETSC_FALSE;
3951   if (isLU || isILU || isCHOL) {
3952     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3953   } else if (sub_schurs && sub_schurs->reuse_solver) {
3954     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3955     MatFactorType      type;
3956 
3957     F = reuse_solver->F;
3958     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3959     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3960     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3961     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3962   } else {
3963     F = NULL;
3964   }
3965 
3966   /* determine if we can use a sparse right-hand side */
3967   sparserhs = PETSC_FALSE;
3968   if (F) {
3969     MatSolverType solver;
3970 
3971     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3972     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3973   }
3974 
3975   /* allocate workspace */
3976   n = 0;
3977   if (n_constraints) {
3978     n += lda_rhs*n_constraints;
3979   }
3980   if (n_vertices) {
3981     n = PetscMax(2*lda_rhs*n_vertices,n);
3982     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3983   }
3984   if (!pcbddc->symmetric_primal) {
3985     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3986   }
3987   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3988 
3989   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3990   dummy_vec = NULL;
3991   if (need_benign_correction && lda_rhs != n_R && F) {
3992     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3993     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3994     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3995   }
3996 
3997   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3998   if (n_constraints) {
3999     Mat         M3,C_B;
4000     IS          is_aux;
4001     PetscScalar *array,*array2;
4002 
4003     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4004     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4005 
4006     /* Extract constraints on R nodes: C_{CR}  */
4007     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4008     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4009     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4010 
4011     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4012     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4013     if (!sparserhs) {
4014       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4015       for (i=0;i<n_constraints;i++) {
4016         const PetscScalar *row_cmat_values;
4017         const PetscInt    *row_cmat_indices;
4018         PetscInt          size_of_constraint,j;
4019 
4020         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4021         for (j=0;j<size_of_constraint;j++) {
4022           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4023         }
4024         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4025       }
4026       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4027     } else {
4028       Mat tC_CR;
4029 
4030       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4031       if (lda_rhs != n_R) {
4032         PetscScalar *aa;
4033         PetscInt    r,*ii,*jj;
4034         PetscBool   done;
4035 
4036         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4037         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4038         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4039         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4040         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4041         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4042       } else {
4043         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4044         tC_CR = C_CR;
4045       }
4046       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4047       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4048     }
4049     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4050     if (F) {
4051       if (need_benign_correction) {
4052         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4053 
4054         /* rhs is already zero on interior dofs, no need to change the rhs */
4055         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4056       }
4057       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4058       if (need_benign_correction) {
4059         PetscScalar        *marr;
4060         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4061 
4062         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4063         if (lda_rhs != n_R) {
4064           for (i=0;i<n_constraints;i++) {
4065             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4066             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4067             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4068           }
4069         } else {
4070           for (i=0;i<n_constraints;i++) {
4071             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4072             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4073             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4074           }
4075         }
4076         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4077       }
4078     } else {
4079       PetscScalar *marr;
4080 
4081       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4082       for (i=0;i<n_constraints;i++) {
4083         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4084         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4085         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4086         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4087         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4088         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4089       }
4090       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4091     }
4092     if (sparserhs) {
4093       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4094     }
4095     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4096     if (!pcbddc->switch_static) {
4097       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4098       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4099       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4100       for (i=0;i<n_constraints;i++) {
4101         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4102         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4103         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4104         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4105         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4106         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4107       }
4108       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4109       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4110       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4111     } else {
4112       if (lda_rhs != n_R) {
4113         IS dummy;
4114 
4115         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4116         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4117         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4118       } else {
4119         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4120         pcbddc->local_auxmat2 = local_auxmat2_R;
4121       }
4122       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4123     }
4124     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4125     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4126     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4127     if (isCHOL) {
4128       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4129     } else {
4130       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4131     }
4132     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4133     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4134     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4135     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4136     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4137     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4138   }
4139 
4140   /* Get submatrices from subdomain matrix */
4141   if (n_vertices) {
4142     IS        is_aux;
4143     PetscBool isseqaij;
4144 
4145     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4146       IS tis;
4147 
4148       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4149       ierr = ISSort(tis);CHKERRQ(ierr);
4150       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4151       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4152     } else {
4153       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4154     }
4155     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4156     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4157     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4158     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4159       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4160     }
4161     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4162     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4163   }
4164 
4165   /* Matrix of coarse basis functions (local) */
4166   if (pcbddc->coarse_phi_B) {
4167     PetscInt on_B,on_primal,on_D=n_D;
4168     if (pcbddc->coarse_phi_D) {
4169       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4170     }
4171     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4172     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4173       PetscScalar *marray;
4174 
4175       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4176       ierr = PetscFree(marray);CHKERRQ(ierr);
4177       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4178       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4179       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4180       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4181     }
4182   }
4183 
4184   if (!pcbddc->coarse_phi_B) {
4185     PetscScalar *marr;
4186 
4187     /* memory size */
4188     n = n_B*pcbddc->local_primal_size;
4189     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4190     if (!pcbddc->symmetric_primal) n *= 2;
4191     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4192     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4193     marr += n_B*pcbddc->local_primal_size;
4194     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4195       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4196       marr += n_D*pcbddc->local_primal_size;
4197     }
4198     if (!pcbddc->symmetric_primal) {
4199       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4200       marr += n_B*pcbddc->local_primal_size;
4201       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4202         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4203       }
4204     } else {
4205       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4206       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4207       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4208         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4209         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4210       }
4211     }
4212   }
4213 
4214   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4215   p0_lidx_I = NULL;
4216   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4217     const PetscInt *idxs;
4218 
4219     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4220     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4221     for (i=0;i<pcbddc->benign_n;i++) {
4222       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4223     }
4224     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4225   }
4226 
4227   /* vertices */
4228   if (n_vertices) {
4229     PetscBool restoreavr = PETSC_FALSE;
4230 
4231     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4232 
4233     if (n_R) {
4234       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4235       PetscBLASInt      B_N,B_one = 1;
4236       const PetscScalar *x;
4237       PetscScalar       *y;
4238 
4239       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4240       if (need_benign_correction) {
4241         ISLocalToGlobalMapping RtoN;
4242         IS                     is_p0;
4243         PetscInt               *idxs_p0,n;
4244 
4245         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4246         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4247         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4248         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);
4249         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4250         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4251         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4252         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4253       }
4254 
4255       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4256       if (!sparserhs || need_benign_correction) {
4257         if (lda_rhs == n_R) {
4258           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4259         } else {
4260           PetscScalar    *av,*array;
4261           const PetscInt *xadj,*adjncy;
4262           PetscInt       n;
4263           PetscBool      flg_row;
4264 
4265           array = work+lda_rhs*n_vertices;
4266           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4267           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4268           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4269           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4270           for (i=0;i<n;i++) {
4271             PetscInt j;
4272             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4273           }
4274           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4275           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4276           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4277         }
4278         if (need_benign_correction) {
4279           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4280           PetscScalar        *marr;
4281 
4282           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4283           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4284 
4285                  | 0 0  0 | (V)
4286              L = | 0 0 -1 | (P-p0)
4287                  | 0 0 -1 | (p0)
4288 
4289           */
4290           for (i=0;i<reuse_solver->benign_n;i++) {
4291             const PetscScalar *vals;
4292             const PetscInt    *idxs,*idxs_zero;
4293             PetscInt          n,j,nz;
4294 
4295             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4296             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4297             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4298             for (j=0;j<n;j++) {
4299               PetscScalar val = vals[j];
4300               PetscInt    k,col = idxs[j];
4301               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4302             }
4303             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4304             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4305           }
4306           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4307         }
4308         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4309         Brhs = A_RV;
4310       } else {
4311         Mat tA_RVT,A_RVT;
4312 
4313         if (!pcbddc->symmetric_primal) {
4314           /* A_RV already scaled by -1 */
4315           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4316         } else {
4317           restoreavr = PETSC_TRUE;
4318           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4319           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4320           A_RVT = A_VR;
4321         }
4322         if (lda_rhs != n_R) {
4323           PetscScalar *aa;
4324           PetscInt    r,*ii,*jj;
4325           PetscBool   done;
4326 
4327           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4328           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4329           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4330           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4331           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4332           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4333         } else {
4334           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4335           tA_RVT = A_RVT;
4336         }
4337         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4338         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4339         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4340       }
4341       if (F) {
4342         /* need to correct the rhs */
4343         if (need_benign_correction) {
4344           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4345           PetscScalar        *marr;
4346 
4347           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4348           if (lda_rhs != n_R) {
4349             for (i=0;i<n_vertices;i++) {
4350               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4351               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4352               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4353             }
4354           } else {
4355             for (i=0;i<n_vertices;i++) {
4356               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4357               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4358               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4359             }
4360           }
4361           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4362         }
4363         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4364         if (restoreavr) {
4365           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4366         }
4367         /* need to correct the solution */
4368         if (need_benign_correction) {
4369           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4370           PetscScalar        *marr;
4371 
4372           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4373           if (lda_rhs != n_R) {
4374             for (i=0;i<n_vertices;i++) {
4375               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4376               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4377               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4378             }
4379           } else {
4380             for (i=0;i<n_vertices;i++) {
4381               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4382               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4383               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4384             }
4385           }
4386           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4387         }
4388       } else {
4389         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4390         for (i=0;i<n_vertices;i++) {
4391           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4392           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4393           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4394           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4395           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4396           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4397         }
4398         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4399       }
4400       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4401       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4402       /* S_VV and S_CV */
4403       if (n_constraints) {
4404         Mat B;
4405 
4406         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4407         for (i=0;i<n_vertices;i++) {
4408           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4409           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4410           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4411           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4412           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4413           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4414         }
4415         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4416         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4417         ierr = MatDestroy(&B);CHKERRQ(ierr);
4418         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4419         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4420         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4421         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4422         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4423         ierr = MatDestroy(&B);CHKERRQ(ierr);
4424       }
4425       if (lda_rhs != n_R) {
4426         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4427         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4428         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4429       }
4430       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4431       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4432       if (need_benign_correction) {
4433         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4434         PetscScalar      *marr,*sums;
4435 
4436         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4437         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4438         for (i=0;i<reuse_solver->benign_n;i++) {
4439           const PetscScalar *vals;
4440           const PetscInt    *idxs,*idxs_zero;
4441           PetscInt          n,j,nz;
4442 
4443           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4444           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4445           for (j=0;j<n_vertices;j++) {
4446             PetscInt k;
4447             sums[j] = 0.;
4448             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4449           }
4450           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4451           for (j=0;j<n;j++) {
4452             PetscScalar val = vals[j];
4453             PetscInt k;
4454             for (k=0;k<n_vertices;k++) {
4455               marr[idxs[j]+k*n_vertices] += val*sums[k];
4456             }
4457           }
4458           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4459           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4460         }
4461         ierr = PetscFree(sums);CHKERRQ(ierr);
4462         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4463         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4464       }
4465       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4466       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4467       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4468       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4469       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4470       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4471       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4472       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4473       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4474     } else {
4475       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4476     }
4477     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4478 
4479     /* coarse basis functions */
4480     for (i=0;i<n_vertices;i++) {
4481       PetscScalar *y;
4482 
4483       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4484       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4485       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4486       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4487       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4488       y[n_B*i+idx_V_B[i]] = 1.0;
4489       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4490       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4491 
4492       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4493         PetscInt j;
4494 
4495         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4496         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4497         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4498         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4499         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4500         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4501         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4502       }
4503       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4504     }
4505     /* if n_R == 0 the object is not destroyed */
4506     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4507   }
4508   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4509 
4510   if (n_constraints) {
4511     Mat B;
4512 
4513     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4514     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4515     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4516     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4517     if (n_vertices) {
4518       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4519         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4520       } else {
4521         Mat S_VCt;
4522 
4523         if (lda_rhs != n_R) {
4524           ierr = MatDestroy(&B);CHKERRQ(ierr);
4525           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4526           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4527         }
4528         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4529         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4530         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4531       }
4532     }
4533     ierr = MatDestroy(&B);CHKERRQ(ierr);
4534     /* coarse basis functions */
4535     for (i=0;i<n_constraints;i++) {
4536       PetscScalar *y;
4537 
4538       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4539       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4540       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4541       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4542       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4543       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4544       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4545       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4546         PetscInt j;
4547 
4548         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4549         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4550         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4551         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4552         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4553         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4554         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4555       }
4556       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4557     }
4558   }
4559   if (n_constraints) {
4560     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4561   }
4562   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4563 
4564   /* coarse matrix entries relative to B_0 */
4565   if (pcbddc->benign_n) {
4566     Mat               B0_B,B0_BPHI;
4567     IS                is_dummy;
4568     const PetscScalar *data;
4569     PetscInt          j;
4570 
4571     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4572     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4573     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4574     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4575     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4576     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4577     for (j=0;j<pcbddc->benign_n;j++) {
4578       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4579       for (i=0;i<pcbddc->local_primal_size;i++) {
4580         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4581         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4582       }
4583     }
4584     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4585     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4586     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4587   }
4588 
4589   /* compute other basis functions for non-symmetric problems */
4590   if (!pcbddc->symmetric_primal) {
4591     Mat         B_V=NULL,B_C=NULL;
4592     PetscScalar *marray;
4593 
4594     if (n_constraints) {
4595       Mat S_CCT,C_CRT;
4596 
4597       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4598       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4599       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4600       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4601       if (n_vertices) {
4602         Mat S_VCT;
4603 
4604         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4605         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4606         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4607       }
4608       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4609     } else {
4610       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4611     }
4612     if (n_vertices && n_R) {
4613       PetscScalar    *av,*marray;
4614       const PetscInt *xadj,*adjncy;
4615       PetscInt       n;
4616       PetscBool      flg_row;
4617 
4618       /* B_V = B_V - A_VR^T */
4619       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4620       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4621       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4622       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4623       for (i=0;i<n;i++) {
4624         PetscInt j;
4625         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4626       }
4627       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4628       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4629       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4630     }
4631 
4632     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4633     if (n_vertices) {
4634       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4635       for (i=0;i<n_vertices;i++) {
4636         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4637         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4638         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4639         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4640         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4641         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4642       }
4643       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4644     }
4645     if (B_C) {
4646       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4647       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4648         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4649         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4650         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4651         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4652         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4653         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4654       }
4655       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4656     }
4657     /* coarse basis functions */
4658     for (i=0;i<pcbddc->local_primal_size;i++) {
4659       PetscScalar *y;
4660 
4661       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4662       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4663       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4664       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4665       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4666       if (i<n_vertices) {
4667         y[n_B*i+idx_V_B[i]] = 1.0;
4668       }
4669       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4670       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4671 
4672       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4673         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4674         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4675         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4676         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4677         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4678         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4679       }
4680       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4681     }
4682     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4683     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4684   }
4685 
4686   /* free memory */
4687   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4688   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4689   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4690   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4691   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4692   ierr = PetscFree(work);CHKERRQ(ierr);
4693   if (n_vertices) {
4694     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4695   }
4696   if (n_constraints) {
4697     ierr = MatDestroy(&C_CR);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   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4886   PetscFunctionReturn(0);
4887 }
4888 
4889 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4890 {
4891   Mat            *work_mat;
4892   IS             isrow_s,iscol_s;
4893   PetscBool      rsorted,csorted;
4894   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4895   PetscErrorCode ierr;
4896 
4897   PetscFunctionBegin;
4898   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4899   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4900   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4901   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4902 
4903   if (!rsorted) {
4904     const PetscInt *idxs;
4905     PetscInt *idxs_sorted,i;
4906 
4907     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4908     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4909     for (i=0;i<rsize;i++) {
4910       idxs_perm_r[i] = i;
4911     }
4912     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4913     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4914     for (i=0;i<rsize;i++) {
4915       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4916     }
4917     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4918     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4919   } else {
4920     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4921     isrow_s = isrow;
4922   }
4923 
4924   if (!csorted) {
4925     if (isrow == iscol) {
4926       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4927       iscol_s = isrow_s;
4928     } else {
4929       const PetscInt *idxs;
4930       PetscInt       *idxs_sorted,i;
4931 
4932       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4933       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4934       for (i=0;i<csize;i++) {
4935         idxs_perm_c[i] = i;
4936       }
4937       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4938       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4939       for (i=0;i<csize;i++) {
4940         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4941       }
4942       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4943       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4944     }
4945   } else {
4946     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4947     iscol_s = iscol;
4948   }
4949 
4950   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4951 
4952   if (!rsorted || !csorted) {
4953     Mat      new_mat;
4954     IS       is_perm_r,is_perm_c;
4955 
4956     if (!rsorted) {
4957       PetscInt *idxs_r,i;
4958       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4959       for (i=0;i<rsize;i++) {
4960         idxs_r[idxs_perm_r[i]] = i;
4961       }
4962       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4963       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4964     } else {
4965       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4966     }
4967     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4968 
4969     if (!csorted) {
4970       if (isrow_s == iscol_s) {
4971         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4972         is_perm_c = is_perm_r;
4973       } else {
4974         PetscInt *idxs_c,i;
4975         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4976         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4977         for (i=0;i<csize;i++) {
4978           idxs_c[idxs_perm_c[i]] = i;
4979         }
4980         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4981         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4982       }
4983     } else {
4984       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4985     }
4986     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4987 
4988     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4989     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4990     work_mat[0] = new_mat;
4991     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4992     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4993   }
4994 
4995   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4996   *B = work_mat[0];
4997   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4998   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4999   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5000   PetscFunctionReturn(0);
5001 }
5002 
5003 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5004 {
5005   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5006   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5007   Mat            new_mat,lA;
5008   IS             is_local,is_global;
5009   PetscInt       local_size;
5010   PetscBool      isseqaij;
5011   PetscErrorCode ierr;
5012 
5013   PetscFunctionBegin;
5014   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5015   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5016   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5017   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5018   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5019   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5020   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5021 
5022   /* check */
5023   if (pcbddc->dbg_flag) {
5024     Vec       x,x_change;
5025     PetscReal error;
5026 
5027     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5028     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5029     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5030     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5031     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5032     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5033     if (!pcbddc->change_interior) {
5034       const PetscScalar *x,*y,*v;
5035       PetscReal         lerror = 0.;
5036       PetscInt          i;
5037 
5038       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5039       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5040       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5041       for (i=0;i<local_size;i++)
5042         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5043           lerror = PetscAbsScalar(x[i]-y[i]);
5044       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5045       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5046       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5047       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5048       if (error > PETSC_SMALL) {
5049         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5050           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5051         } else {
5052           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5053         }
5054       }
5055     }
5056     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5057     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5058     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5059     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5060     if (error > PETSC_SMALL) {
5061       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5062         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5063       } else {
5064         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5065       }
5066     }
5067     ierr = VecDestroy(&x);CHKERRQ(ierr);
5068     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5069   }
5070 
5071   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5072   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5073 
5074   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5075   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5076   if (isseqaij) {
5077     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5078     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5079     if (lA) {
5080       Mat work;
5081       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5082       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5083       ierr = MatDestroy(&work);CHKERRQ(ierr);
5084     }
5085   } else {
5086     Mat work_mat;
5087 
5088     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5089     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5090     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5091     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5092     if (lA) {
5093       Mat work;
5094       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5095       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5096       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5097       ierr = MatDestroy(&work);CHKERRQ(ierr);
5098     }
5099   }
5100   if (matis->A->symmetric_set) {
5101     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5102 #if !defined(PETSC_USE_COMPLEX)
5103     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5104 #endif
5105   }
5106   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5107   PetscFunctionReturn(0);
5108 }
5109 
5110 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5111 {
5112   PC_IS*          pcis = (PC_IS*)(pc->data);
5113   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5114   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5115   PetscInt        *idx_R_local=NULL;
5116   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5117   PetscInt        vbs,bs;
5118   PetscBT         bitmask=NULL;
5119   PetscErrorCode  ierr;
5120 
5121   PetscFunctionBegin;
5122   /*
5123     No need to setup local scatters if
5124       - primal space is unchanged
5125         AND
5126       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5127         AND
5128       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5129   */
5130   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5131     PetscFunctionReturn(0);
5132   }
5133   /* destroy old objects */
5134   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5135   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5136   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5137   /* Set Non-overlapping dimensions */
5138   n_B = pcis->n_B;
5139   n_D = pcis->n - n_B;
5140   n_vertices = pcbddc->n_vertices;
5141 
5142   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5143 
5144   /* create auxiliary bitmask and allocate workspace */
5145   if (!sub_schurs || !sub_schurs->reuse_solver) {
5146     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5147     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5148     for (i=0;i<n_vertices;i++) {
5149       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5150     }
5151 
5152     for (i=0, n_R=0; i<pcis->n; i++) {
5153       if (!PetscBTLookup(bitmask,i)) {
5154         idx_R_local[n_R++] = i;
5155       }
5156     }
5157   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5158     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5159 
5160     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5161     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5162   }
5163 
5164   /* Block code */
5165   vbs = 1;
5166   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5167   if (bs>1 && !(n_vertices%bs)) {
5168     PetscBool is_blocked = PETSC_TRUE;
5169     PetscInt  *vary;
5170     if (!sub_schurs || !sub_schurs->reuse_solver) {
5171       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5172       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5173       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5174       /* 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 */
5175       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5176       for (i=0; i<pcis->n/bs; i++) {
5177         if (vary[i]!=0 && vary[i]!=bs) {
5178           is_blocked = PETSC_FALSE;
5179           break;
5180         }
5181       }
5182       ierr = PetscFree(vary);CHKERRQ(ierr);
5183     } else {
5184       /* Verify directly the R set */
5185       for (i=0; i<n_R/bs; i++) {
5186         PetscInt j,node=idx_R_local[bs*i];
5187         for (j=1; j<bs; j++) {
5188           if (node != idx_R_local[bs*i+j]-j) {
5189             is_blocked = PETSC_FALSE;
5190             break;
5191           }
5192         }
5193       }
5194     }
5195     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5196       vbs = bs;
5197       for (i=0;i<n_R/vbs;i++) {
5198         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5199       }
5200     }
5201   }
5202   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5203   if (sub_schurs && sub_schurs->reuse_solver) {
5204     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5205 
5206     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5207     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5208     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5209     reuse_solver->is_R = pcbddc->is_R_local;
5210   } else {
5211     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5212   }
5213 
5214   /* print some info if requested */
5215   if (pcbddc->dbg_flag) {
5216     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5217     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5219     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5220     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5221     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);
5222     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5223   }
5224 
5225   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5226   if (!sub_schurs || !sub_schurs->reuse_solver) {
5227     IS       is_aux1,is_aux2;
5228     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5229 
5230     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5231     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5232     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5233     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5234     for (i=0; i<n_D; i++) {
5235       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5236     }
5237     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5238     for (i=0, j=0; i<n_R; i++) {
5239       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5240         aux_array1[j++] = i;
5241       }
5242     }
5243     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5244     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5245     for (i=0, j=0; i<n_B; i++) {
5246       if (!PetscBTLookup(bitmask,is_indices[i])) {
5247         aux_array2[j++] = i;
5248       }
5249     }
5250     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5251     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5252     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5253     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5254     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5255 
5256     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5257       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5258       for (i=0, j=0; i<n_R; i++) {
5259         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5260           aux_array1[j++] = i;
5261         }
5262       }
5263       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5264       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5265       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5266     }
5267     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5268     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5269   } else {
5270     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5271     IS                 tis;
5272     PetscInt           schur_size;
5273 
5274     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5275     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5276     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5277     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5278     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5279       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5280       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5281       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5282     }
5283   }
5284   PetscFunctionReturn(0);
5285 }
5286 
5287 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B)
5288 {
5289   MatNullSpace   NullSpace;
5290   Mat            dmat;
5291   const Vec      *nullvecs;
5292   Vec            v,v2,*nullvecs2;
5293   VecScatter     sct;
5294   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5295   PetscBool      nnsp_has_cnst;
5296   PetscErrorCode ierr;
5297 
5298   PetscFunctionBegin;
5299   ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5300   if (!NullSpace) {
5301     ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5302   }
5303   if (NullSpace) PetscFunctionReturn(0);
5304   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5305   if (!NullSpace) {
5306     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5307   }
5308   if (!NullSpace) PetscFunctionReturn(0);
5309   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5310   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5311   ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5312   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5313   bsiz = nnsp_size+!!nnsp_has_cnst;
5314   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5315   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5316   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5317   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5318   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5319   for (k=0;k<nnsp_size;k++) {
5320     PetscScalar *arr;
5321 
5322     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5323     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5324     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5325     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5326     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5327   }
5328   if (nnsp_has_cnst) {
5329     PetscScalar *arr;
5330 
5331     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5332     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5333     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5334     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5335   }
5336   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5337   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5338   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5339   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5340   for (k=0;k<bsiz;k++) {
5341     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5342   }
5343   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5344   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5345   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5346   ierr = VecDestroy(&v);CHKERRQ(ierr);
5347   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5348   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5349   PetscFunctionReturn(0);
5350 }
5351 
5352 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5353 {
5354   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5355   PC_IS          *pcis = (PC_IS*)pc->data;
5356   PC             pc_temp;
5357   Mat            A_RR;
5358   MatNullSpace   nnsp;
5359   MatReuse       reuse;
5360   PetscScalar    m_one = -1.0;
5361   PetscReal      value;
5362   PetscInt       n_D,n_R;
5363   PetscBool      issbaij,opts;
5364   PetscErrorCode ierr;
5365   void           (*f)(void) = 0;
5366   char           dir_prefix[256],neu_prefix[256],str_level[16];
5367   size_t         len;
5368 
5369   PetscFunctionBegin;
5370   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5371   /* compute prefixes */
5372   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5373   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5374   if (!pcbddc->current_level) {
5375     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5376     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5377     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5378     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5379   } else {
5380     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5381     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5382     len -= 15; /* remove "pc_bddc_coarse_" */
5383     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5384     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5385     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5386     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5387     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5388     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5389     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5390     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5391     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5392   }
5393 
5394   /* DIRICHLET PROBLEM */
5395   if (dirichlet) {
5396     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5397     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5398       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5399       if (pcbddc->dbg_flag) {
5400         Mat    A_IIn;
5401 
5402         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5403         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5404         pcis->A_II = A_IIn;
5405       }
5406     }
5407     if (pcbddc->local_mat->symmetric_set) {
5408       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5409     }
5410     /* Matrix for Dirichlet problem is pcis->A_II */
5411     n_D  = pcis->n - pcis->n_B;
5412     opts = PETSC_FALSE;
5413     if (!pcbddc->ksp_D) { /* create object if not yet build */
5414       opts = PETSC_TRUE;
5415       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5416       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5417       /* default */
5418       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5419       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5420       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5421       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5422       if (issbaij) {
5423         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5424       } else {
5425         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5426       }
5427       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5428     }
5429     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5430     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5431     /* Allow user's customization */
5432     if (opts) {
5433       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5434     }
5435     if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */
5436       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5437     }
5438     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5439     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5440     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5441     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5442       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5443       const PetscInt *idxs;
5444       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5445 
5446       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5447       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5448       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5449       for (i=0;i<nl;i++) {
5450         for (d=0;d<cdim;d++) {
5451           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5452         }
5453       }
5454       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5455       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5456       ierr = PetscFree(scoords);CHKERRQ(ierr);
5457     }
5458     if (sub_schurs && sub_schurs->reuse_solver) {
5459       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5460 
5461       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5462     }
5463 
5464     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5465     if (!n_D) {
5466       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5467       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5468     }
5469     /* set ksp_D into pcis data */
5470     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5471     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5472     pcis->ksp_D = pcbddc->ksp_D;
5473   }
5474 
5475   /* NEUMANN PROBLEM */
5476   A_RR = 0;
5477   if (neumann) {
5478     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5479     PetscInt        ibs,mbs;
5480     PetscBool       issbaij, reuse_neumann_solver;
5481     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5482 
5483     reuse_neumann_solver = PETSC_FALSE;
5484     if (sub_schurs && sub_schurs->reuse_solver) {
5485       IS iP;
5486 
5487       reuse_neumann_solver = PETSC_TRUE;
5488       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5489       if (iP) reuse_neumann_solver = PETSC_FALSE;
5490     }
5491     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5492     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5493     if (pcbddc->ksp_R) { /* already created ksp */
5494       PetscInt nn_R;
5495       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5496       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5497       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5498       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5499         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5500         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5501         reuse = MAT_INITIAL_MATRIX;
5502       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5503         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5504           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5505           reuse = MAT_INITIAL_MATRIX;
5506         } else { /* safe to reuse the matrix */
5507           reuse = MAT_REUSE_MATRIX;
5508         }
5509       }
5510       /* last check */
5511       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5512         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5513         reuse = MAT_INITIAL_MATRIX;
5514       }
5515     } else { /* first time, so we need to create the matrix */
5516       reuse = MAT_INITIAL_MATRIX;
5517     }
5518     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5519     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5520     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5521     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5522     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5523       if (matis->A == pcbddc->local_mat) {
5524         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5525         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5526       } else {
5527         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5528       }
5529     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5530       if (matis->A == pcbddc->local_mat) {
5531         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5532         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5533       } else {
5534         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5535       }
5536     }
5537     /* extract A_RR */
5538     if (reuse_neumann_solver) {
5539       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5540 
5541       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5542         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5543         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5544           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5545         } else {
5546           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5547         }
5548       } else {
5549         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5550         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5551         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5552       }
5553     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5554       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5555     }
5556     if (pcbddc->local_mat->symmetric_set) {
5557       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5558     }
5559     opts = PETSC_FALSE;
5560     if (!pcbddc->ksp_R) { /* create object if not present */
5561       opts = PETSC_TRUE;
5562       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5563       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5564       /* default */
5565       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5566       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5567       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5568       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5569       if (issbaij) {
5570         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5571       } else {
5572         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5573       }
5574       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5575     }
5576     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5577     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5578     if (opts) { /* Allow user's customization once */
5579       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5580     }
5581     if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */
5582       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5583     }
5584     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5585     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5586     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5587     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5588       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5589       const PetscInt *idxs;
5590       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5591 
5592       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5593       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5594       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5595       for (i=0;i<nl;i++) {
5596         for (d=0;d<cdim;d++) {
5597           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5598         }
5599       }
5600       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5601       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5602       ierr = PetscFree(scoords);CHKERRQ(ierr);
5603     }
5604 
5605     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5606     if (!n_R) {
5607       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5608       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5609     }
5610     /* Reuse solver if it is present */
5611     if (reuse_neumann_solver) {
5612       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5613 
5614       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5615     }
5616   }
5617 
5618   if (pcbddc->dbg_flag) {
5619     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5620     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5621     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5622   }
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   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5660   PetscFunctionReturn(0);
5661 }
5662 
5663 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5664 {
5665   PetscErrorCode  ierr;
5666   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5667   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5668   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5669 
5670   PetscFunctionBegin;
5671   if (!reuse_solver) {
5672     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5673   }
5674   if (!pcbddc->switch_static) {
5675     if (applytranspose && pcbddc->local_auxmat1) {
5676       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5677       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5678     }
5679     if (!reuse_solver) {
5680       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5681       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5682     } else {
5683       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5684 
5685       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5686       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5687     }
5688   } else {
5689     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5690     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5691     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5692     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5693     if (applytranspose && pcbddc->local_auxmat1) {
5694       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5695       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5696       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5697       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5698     }
5699   }
5700   if (!reuse_solver || pcbddc->switch_static) {
5701     if (applytranspose) {
5702       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5703     } else {
5704       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5705     }
5706     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5707   } else {
5708     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5709 
5710     if (applytranspose) {
5711       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5712     } else {
5713       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5714     }
5715   }
5716   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5717   if (!pcbddc->switch_static) {
5718     if (!reuse_solver) {
5719       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5720       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5721     } else {
5722       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5723 
5724       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5725       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5726     }
5727     if (!applytranspose && pcbddc->local_auxmat1) {
5728       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5729       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5730     }
5731   } else {
5732     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5733     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5734     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5735     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5736     if (!applytranspose && pcbddc->local_auxmat1) {
5737       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5738       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5739     }
5740     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5741     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5742     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5743     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5744   }
5745   PetscFunctionReturn(0);
5746 }
5747 
5748 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5749 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5750 {
5751   PetscErrorCode ierr;
5752   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5753   PC_IS*            pcis = (PC_IS*)  (pc->data);
5754   const PetscScalar zero = 0.0;
5755 
5756   PetscFunctionBegin;
5757   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5758   if (!pcbddc->benign_apply_coarse_only) {
5759     if (applytranspose) {
5760       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5761       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5762     } else {
5763       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5764       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5765     }
5766   } else {
5767     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5768   }
5769 
5770   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5771   if (pcbddc->benign_n) {
5772     PetscScalar *array;
5773     PetscInt    j;
5774 
5775     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5776     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5777     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5778   }
5779 
5780   /* start communications from local primal nodes to rhs of coarse solver */
5781   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5782   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5783   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5784 
5785   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5786   if (pcbddc->coarse_ksp) {
5787     Mat          coarse_mat;
5788     Vec          rhs,sol;
5789     MatNullSpace nullsp;
5790     PetscBool    isbddc = PETSC_FALSE;
5791 
5792     if (pcbddc->benign_have_null) {
5793       PC        coarse_pc;
5794 
5795       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5796       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5797       /* we need to propagate to coarser levels the need for a possible benign correction */
5798       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5799         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5800         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5801         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5802       }
5803     }
5804     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5805     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5806     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5807     if (applytranspose) {
5808       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5809       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5810       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5811       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5812       if (nullsp) {
5813         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5814       }
5815     } else {
5816       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5817       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5818         PC        coarse_pc;
5819 
5820         if (nullsp) {
5821           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5822         }
5823         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5824         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5825         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5826         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5827       } else {
5828         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5829         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5830         if (nullsp) {
5831           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5832         }
5833       }
5834     }
5835     /* we don't need the benign correction at coarser levels anymore */
5836     if (pcbddc->benign_have_null && isbddc) {
5837       PC        coarse_pc;
5838       PC_BDDC*  coarsepcbddc;
5839 
5840       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5841       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5842       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5843       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5844     }
5845   }
5846 
5847   /* Local solution on R nodes */
5848   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5849     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5850   }
5851   /* communications from coarse sol to local primal nodes */
5852   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5853   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5854 
5855   /* Sum contributions from the two levels */
5856   if (!pcbddc->benign_apply_coarse_only) {
5857     if (applytranspose) {
5858       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5859       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5860     } else {
5861       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5862       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5863     }
5864     /* store p0 */
5865     if (pcbddc->benign_n) {
5866       PetscScalar *array;
5867       PetscInt    j;
5868 
5869       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5870       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5871       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5872     }
5873   } else { /* expand the coarse solution */
5874     if (applytranspose) {
5875       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5876     } else {
5877       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5878     }
5879   }
5880   PetscFunctionReturn(0);
5881 }
5882 
5883 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5884 {
5885   PetscErrorCode ierr;
5886   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5887   PetscScalar    *array;
5888   Vec            from,to;
5889 
5890   PetscFunctionBegin;
5891   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5892     from = pcbddc->coarse_vec;
5893     to = pcbddc->vec1_P;
5894     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5895       Vec tvec;
5896 
5897       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5898       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5899       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5900       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5901       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5902       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5903     }
5904   } else { /* from local to global -> put data in coarse right hand side */
5905     from = pcbddc->vec1_P;
5906     to = pcbddc->coarse_vec;
5907   }
5908   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5909   PetscFunctionReturn(0);
5910 }
5911 
5912 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5913 {
5914   PetscErrorCode ierr;
5915   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5916   PetscScalar    *array;
5917   Vec            from,to;
5918 
5919   PetscFunctionBegin;
5920   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5921     from = pcbddc->coarse_vec;
5922     to = pcbddc->vec1_P;
5923   } else { /* from local to global -> put data in coarse right hand side */
5924     from = pcbddc->vec1_P;
5925     to = pcbddc->coarse_vec;
5926   }
5927   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5928   if (smode == SCATTER_FORWARD) {
5929     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5930       Vec tvec;
5931 
5932       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5933       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5934       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5935       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5936     }
5937   } else {
5938     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5939      ierr = VecResetArray(from);CHKERRQ(ierr);
5940     }
5941   }
5942   PetscFunctionReturn(0);
5943 }
5944 
5945 /* uncomment for testing purposes */
5946 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5947 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5948 {
5949   PetscErrorCode    ierr;
5950   PC_IS*            pcis = (PC_IS*)(pc->data);
5951   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5952   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5953   /* one and zero */
5954   PetscScalar       one=1.0,zero=0.0;
5955   /* space to store constraints and their local indices */
5956   PetscScalar       *constraints_data;
5957   PetscInt          *constraints_idxs,*constraints_idxs_B;
5958   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5959   PetscInt          *constraints_n;
5960   /* iterators */
5961   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5962   /* BLAS integers */
5963   PetscBLASInt      lwork,lierr;
5964   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5965   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5966   /* reuse */
5967   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5968   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5969   /* change of basis */
5970   PetscBool         qr_needed;
5971   PetscBT           change_basis,qr_needed_idx;
5972   /* auxiliary stuff */
5973   PetscInt          *nnz,*is_indices;
5974   PetscInt          ncc;
5975   /* some quantities */
5976   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5977   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5978   PetscReal         tol; /* tolerance for retaining eigenmodes */
5979 
5980   PetscFunctionBegin;
5981   tol  = PetscSqrtReal(PETSC_SMALL);
5982   /* Destroy Mat objects computed previously */
5983   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5984   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5985   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5986   /* save info on constraints from previous setup (if any) */
5987   olocal_primal_size = pcbddc->local_primal_size;
5988   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5989   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5990   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
5991   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
5992   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5993   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5994 
5995   if (!pcbddc->adaptive_selection) {
5996     IS           ISForVertices,*ISForFaces,*ISForEdges;
5997     MatNullSpace nearnullsp;
5998     const Vec    *nearnullvecs;
5999     Vec          *localnearnullsp;
6000     PetscScalar  *array;
6001     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6002     PetscBool    nnsp_has_cnst;
6003     /* LAPACK working arrays for SVD or POD */
6004     PetscBool    skip_lapack,boolforchange;
6005     PetscScalar  *work;
6006     PetscReal    *singular_vals;
6007 #if defined(PETSC_USE_COMPLEX)
6008     PetscReal    *rwork;
6009 #endif
6010 #if defined(PETSC_MISSING_LAPACK_GESVD)
6011     PetscScalar  *temp_basis,*correlation_mat;
6012 #else
6013     PetscBLASInt dummy_int=1;
6014     PetscScalar  dummy_scalar=1.;
6015 #endif
6016 
6017     /* Get index sets for faces, edges and vertices from graph */
6018     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6019     /* print some info */
6020     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6021       PetscInt nv;
6022 
6023       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6024       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6025       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6026       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6027       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6028       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6029       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6030       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6031       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6032     }
6033 
6034     /* free unneeded index sets */
6035     if (!pcbddc->use_vertices) {
6036       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6037     }
6038     if (!pcbddc->use_edges) {
6039       for (i=0;i<n_ISForEdges;i++) {
6040         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6041       }
6042       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6043       n_ISForEdges = 0;
6044     }
6045     if (!pcbddc->use_faces) {
6046       for (i=0;i<n_ISForFaces;i++) {
6047         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6048       }
6049       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6050       n_ISForFaces = 0;
6051     }
6052 
6053     /* check if near null space is attached to global mat */
6054     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6055     if (nearnullsp) {
6056       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6057       /* remove any stored info */
6058       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6059       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6060       /* store information for BDDC solver reuse */
6061       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6062       pcbddc->onearnullspace = nearnullsp;
6063       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6064       for (i=0;i<nnsp_size;i++) {
6065         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6066       }
6067     } else { /* if near null space is not provided BDDC uses constants by default */
6068       nnsp_size = 0;
6069       nnsp_has_cnst = PETSC_TRUE;
6070     }
6071     /* get max number of constraints on a single cc */
6072     max_constraints = nnsp_size;
6073     if (nnsp_has_cnst) max_constraints++;
6074 
6075     /*
6076          Evaluate maximum storage size needed by the procedure
6077          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6078          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6079          There can be multiple constraints per connected component
6080                                                                                                                                                            */
6081     n_vertices = 0;
6082     if (ISForVertices) {
6083       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6084     }
6085     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6086     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6087 
6088     total_counts = n_ISForFaces+n_ISForEdges;
6089     total_counts *= max_constraints;
6090     total_counts += n_vertices;
6091     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6092 
6093     total_counts = 0;
6094     max_size_of_constraint = 0;
6095     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6096       IS used_is;
6097       if (i<n_ISForEdges) {
6098         used_is = ISForEdges[i];
6099       } else {
6100         used_is = ISForFaces[i-n_ISForEdges];
6101       }
6102       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6103       total_counts += j;
6104       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6105     }
6106     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);
6107 
6108     /* get local part of global near null space vectors */
6109     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6110     for (k=0;k<nnsp_size;k++) {
6111       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6112       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6113       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6114     }
6115 
6116     /* whether or not to skip lapack calls */
6117     skip_lapack = PETSC_TRUE;
6118     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6119 
6120     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6121     if (!skip_lapack) {
6122       PetscScalar temp_work;
6123 
6124 #if defined(PETSC_MISSING_LAPACK_GESVD)
6125       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6126       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6127       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6128       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6129 #if defined(PETSC_USE_COMPLEX)
6130       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6131 #endif
6132       /* now we evaluate the optimal workspace using query with lwork=-1 */
6133       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6134       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6135       lwork = -1;
6136       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6137 #if !defined(PETSC_USE_COMPLEX)
6138       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6139 #else
6140       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6141 #endif
6142       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6143       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6144 #else /* on missing GESVD */
6145       /* SVD */
6146       PetscInt max_n,min_n;
6147       max_n = max_size_of_constraint;
6148       min_n = max_constraints;
6149       if (max_size_of_constraint < max_constraints) {
6150         min_n = max_size_of_constraint;
6151         max_n = max_constraints;
6152       }
6153       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6154 #if defined(PETSC_USE_COMPLEX)
6155       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6156 #endif
6157       /* now we evaluate the optimal workspace using query with lwork=-1 */
6158       lwork = -1;
6159       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6160       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6161       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6162       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6163 #if !defined(PETSC_USE_COMPLEX)
6164       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));
6165 #else
6166       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));
6167 #endif
6168       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6169       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6170 #endif /* on missing GESVD */
6171       /* Allocate optimal workspace */
6172       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6173       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6174     }
6175     /* Now we can loop on constraining sets */
6176     total_counts = 0;
6177     constraints_idxs_ptr[0] = 0;
6178     constraints_data_ptr[0] = 0;
6179     /* vertices */
6180     if (n_vertices) {
6181       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6182       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6183       for (i=0;i<n_vertices;i++) {
6184         constraints_n[total_counts] = 1;
6185         constraints_data[total_counts] = 1.0;
6186         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6187         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6188         total_counts++;
6189       }
6190       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6191       n_vertices = total_counts;
6192     }
6193 
6194     /* edges and faces */
6195     total_counts_cc = total_counts;
6196     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6197       IS        used_is;
6198       PetscBool idxs_copied = PETSC_FALSE;
6199 
6200       if (ncc<n_ISForEdges) {
6201         used_is = ISForEdges[ncc];
6202         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6203       } else {
6204         used_is = ISForFaces[ncc-n_ISForEdges];
6205         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6206       }
6207       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6208 
6209       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6210       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6211       /* change of basis should not be performed on local periodic nodes */
6212       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6213       if (nnsp_has_cnst) {
6214         PetscScalar quad_value;
6215 
6216         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6217         idxs_copied = PETSC_TRUE;
6218 
6219         if (!pcbddc->use_nnsp_true) {
6220           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6221         } else {
6222           quad_value = 1.0;
6223         }
6224         for (j=0;j<size_of_constraint;j++) {
6225           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6226         }
6227         temp_constraints++;
6228         total_counts++;
6229       }
6230       for (k=0;k<nnsp_size;k++) {
6231         PetscReal real_value;
6232         PetscScalar *ptr_to_data;
6233 
6234         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6235         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6236         for (j=0;j<size_of_constraint;j++) {
6237           ptr_to_data[j] = array[is_indices[j]];
6238         }
6239         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6240         /* check if array is null on the connected component */
6241         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6242         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6243         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6244           temp_constraints++;
6245           total_counts++;
6246           if (!idxs_copied) {
6247             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6248             idxs_copied = PETSC_TRUE;
6249           }
6250         }
6251       }
6252       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6253       valid_constraints = temp_constraints;
6254       if (!pcbddc->use_nnsp_true && temp_constraints) {
6255         if (temp_constraints == 1) { /* just normalize the constraint */
6256           PetscScalar norm,*ptr_to_data;
6257 
6258           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6259           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6260           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6261           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6262           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6263         } else { /* perform SVD */
6264           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6265 
6266 #if defined(PETSC_MISSING_LAPACK_GESVD)
6267           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6268              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6269              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6270                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6271                 from that computed using LAPACKgesvd
6272              -> This is due to a different computation of eigenvectors in LAPACKheev
6273              -> The quality of the POD-computed basis will be the same */
6274           ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6275           /* Store upper triangular part of correlation matrix */
6276           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6277           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6278           for (j=0;j<temp_constraints;j++) {
6279             for (k=0;k<j+1;k++) {
6280               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));
6281             }
6282           }
6283           /* compute eigenvalues and eigenvectors of correlation matrix */
6284           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6285           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6286 #if !defined(PETSC_USE_COMPLEX)
6287           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6288 #else
6289           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6290 #endif
6291           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6292           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6293           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6294           j = 0;
6295           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6296           total_counts = total_counts-j;
6297           valid_constraints = temp_constraints-j;
6298           /* scale and copy POD basis into used quadrature memory */
6299           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6300           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6301           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6302           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6303           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6304           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6305           if (j<temp_constraints) {
6306             PetscInt ii;
6307             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6308             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6309             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));
6310             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6311             for (k=0;k<temp_constraints-j;k++) {
6312               for (ii=0;ii<size_of_constraint;ii++) {
6313                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6314               }
6315             }
6316           }
6317 #else  /* on missing GESVD */
6318           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6319           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6320           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6321           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6322 #if !defined(PETSC_USE_COMPLEX)
6323           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));
6324 #else
6325           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));
6326 #endif
6327           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6328           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6329           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6330           k = temp_constraints;
6331           if (k > size_of_constraint) k = size_of_constraint;
6332           j = 0;
6333           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6334           valid_constraints = k-j;
6335           total_counts = total_counts-temp_constraints+valid_constraints;
6336 #endif /* on missing GESVD */
6337         }
6338       }
6339       /* update pointers information */
6340       if (valid_constraints) {
6341         constraints_n[total_counts_cc] = valid_constraints;
6342         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6343         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6344         /* set change_of_basis flag */
6345         if (boolforchange) {
6346           PetscBTSet(change_basis,total_counts_cc);
6347         }
6348         total_counts_cc++;
6349       }
6350     }
6351     /* free workspace */
6352     if (!skip_lapack) {
6353       ierr = PetscFree(work);CHKERRQ(ierr);
6354 #if defined(PETSC_USE_COMPLEX)
6355       ierr = PetscFree(rwork);CHKERRQ(ierr);
6356 #endif
6357       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6358 #if defined(PETSC_MISSING_LAPACK_GESVD)
6359       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6360       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6361 #endif
6362     }
6363     for (k=0;k<nnsp_size;k++) {
6364       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6365     }
6366     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6367     /* free index sets of faces, edges and vertices */
6368     for (i=0;i<n_ISForFaces;i++) {
6369       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6370     }
6371     if (n_ISForFaces) {
6372       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6373     }
6374     for (i=0;i<n_ISForEdges;i++) {
6375       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6376     }
6377     if (n_ISForEdges) {
6378       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6379     }
6380     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6381   } else {
6382     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6383 
6384     total_counts = 0;
6385     n_vertices = 0;
6386     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6387       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6388     }
6389     max_constraints = 0;
6390     total_counts_cc = 0;
6391     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6392       total_counts += pcbddc->adaptive_constraints_n[i];
6393       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6394       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6395     }
6396     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6397     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6398     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6399     constraints_data = pcbddc->adaptive_constraints_data;
6400     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6401     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6402     total_counts_cc = 0;
6403     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6404       if (pcbddc->adaptive_constraints_n[i]) {
6405         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6406       }
6407     }
6408 
6409     max_size_of_constraint = 0;
6410     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]);
6411     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6412     /* Change of basis */
6413     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6414     if (pcbddc->use_change_of_basis) {
6415       for (i=0;i<sub_schurs->n_subs;i++) {
6416         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6417           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6418         }
6419       }
6420     }
6421   }
6422   pcbddc->local_primal_size = total_counts;
6423   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6424 
6425   /* map constraints_idxs in boundary numbering */
6426   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6427   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);
6428 
6429   /* Create constraint matrix */
6430   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6431   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6432   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6433 
6434   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6435   /* determine if a QR strategy is needed for change of basis */
6436   qr_needed = pcbddc->use_qr_single;
6437   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6438   total_primal_vertices=0;
6439   pcbddc->local_primal_size_cc = 0;
6440   for (i=0;i<total_counts_cc;i++) {
6441     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6442     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6443       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6444       pcbddc->local_primal_size_cc += 1;
6445     } else if (PetscBTLookup(change_basis,i)) {
6446       for (k=0;k<constraints_n[i];k++) {
6447         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6448       }
6449       pcbddc->local_primal_size_cc += constraints_n[i];
6450       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6451         PetscBTSet(qr_needed_idx,i);
6452         qr_needed = PETSC_TRUE;
6453       }
6454     } else {
6455       pcbddc->local_primal_size_cc += 1;
6456     }
6457   }
6458   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6459   pcbddc->n_vertices = total_primal_vertices;
6460   /* permute indices in order to have a sorted set of vertices */
6461   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6462   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);
6463   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6464   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6465 
6466   /* nonzero structure of constraint matrix */
6467   /* and get reference dof for local constraints */
6468   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6469   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6470 
6471   j = total_primal_vertices;
6472   total_counts = total_primal_vertices;
6473   cum = total_primal_vertices;
6474   for (i=n_vertices;i<total_counts_cc;i++) {
6475     if (!PetscBTLookup(change_basis,i)) {
6476       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6477       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6478       cum++;
6479       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6480       for (k=0;k<constraints_n[i];k++) {
6481         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6482         nnz[j+k] = size_of_constraint;
6483       }
6484       j += constraints_n[i];
6485     }
6486   }
6487   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6488   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6489   ierr = PetscFree(nnz);CHKERRQ(ierr);
6490 
6491   /* set values in constraint matrix */
6492   for (i=0;i<total_primal_vertices;i++) {
6493     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6494   }
6495   total_counts = total_primal_vertices;
6496   for (i=n_vertices;i<total_counts_cc;i++) {
6497     if (!PetscBTLookup(change_basis,i)) {
6498       PetscInt *cols;
6499 
6500       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6501       cols = constraints_idxs+constraints_idxs_ptr[i];
6502       for (k=0;k<constraints_n[i];k++) {
6503         PetscInt    row = total_counts+k;
6504         PetscScalar *vals;
6505 
6506         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6507         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6508       }
6509       total_counts += constraints_n[i];
6510     }
6511   }
6512   /* assembling */
6513   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6514   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6515   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6516 
6517   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6518   if (pcbddc->use_change_of_basis) {
6519     /* dual and primal dofs on a single cc */
6520     PetscInt     dual_dofs,primal_dofs;
6521     /* working stuff for GEQRF */
6522     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6523     PetscBLASInt lqr_work;
6524     /* working stuff for UNGQR */
6525     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6526     PetscBLASInt lgqr_work;
6527     /* working stuff for TRTRS */
6528     PetscScalar  *trs_rhs = NULL;
6529     PetscBLASInt Blas_NRHS;
6530     /* pointers for values insertion into change of basis matrix */
6531     PetscInt     *start_rows,*start_cols;
6532     PetscScalar  *start_vals;
6533     /* working stuff for values insertion */
6534     PetscBT      is_primal;
6535     PetscInt     *aux_primal_numbering_B;
6536     /* matrix sizes */
6537     PetscInt     global_size,local_size;
6538     /* temporary change of basis */
6539     Mat          localChangeOfBasisMatrix;
6540     /* extra space for debugging */
6541     PetscScalar  *dbg_work = NULL;
6542 
6543     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6544     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6545     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6546     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6547     /* nonzeros for local mat */
6548     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6549     if (!pcbddc->benign_change || pcbddc->fake_change) {
6550       for (i=0;i<pcis->n;i++) nnz[i]=1;
6551     } else {
6552       const PetscInt *ii;
6553       PetscInt       n;
6554       PetscBool      flg_row;
6555       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6556       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6557       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6558     }
6559     for (i=n_vertices;i<total_counts_cc;i++) {
6560       if (PetscBTLookup(change_basis,i)) {
6561         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6562         if (PetscBTLookup(qr_needed_idx,i)) {
6563           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6564         } else {
6565           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6566           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6567         }
6568       }
6569     }
6570     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6571     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6572     ierr = PetscFree(nnz);CHKERRQ(ierr);
6573     /* Set interior change in the matrix */
6574     if (!pcbddc->benign_change || pcbddc->fake_change) {
6575       for (i=0;i<pcis->n;i++) {
6576         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6577       }
6578     } else {
6579       const PetscInt *ii,*jj;
6580       PetscScalar    *aa;
6581       PetscInt       n;
6582       PetscBool      flg_row;
6583       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6584       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6585       for (i=0;i<n;i++) {
6586         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6587       }
6588       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6589       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6590     }
6591 
6592     if (pcbddc->dbg_flag) {
6593       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6594       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6595     }
6596 
6597 
6598     /* Now we loop on the constraints which need a change of basis */
6599     /*
6600        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6601        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6602 
6603        Basic blocks of change of basis matrix T computed by
6604 
6605           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6606 
6607             | 1        0   ...        0         s_1/S |
6608             | 0        1   ...        0         s_2/S |
6609             |              ...                        |
6610             | 0        ...            1     s_{n-1}/S |
6611             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6612 
6613             with S = \sum_{i=1}^n s_i^2
6614             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6615                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6616 
6617           - QR decomposition of constraints otherwise
6618     */
6619     if (qr_needed && max_size_of_constraint) {
6620       /* space to store Q */
6621       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6622       /* array to store scaling factors for reflectors */
6623       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6624       /* first we issue queries for optimal work */
6625       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6626       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6627       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6628       lqr_work = -1;
6629       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6630       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6631       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6632       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6633       lgqr_work = -1;
6634       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6635       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6636       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6637       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6638       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6639       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6640       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6641       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6642       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6643       /* array to store rhs and solution of triangular solver */
6644       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6645       /* allocating workspace for check */
6646       if (pcbddc->dbg_flag) {
6647         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6648       }
6649     }
6650     /* array to store whether a node is primal or not */
6651     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6652     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6653     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6654     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);
6655     for (i=0;i<total_primal_vertices;i++) {
6656       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6657     }
6658     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6659 
6660     /* loop on constraints and see whether or not they need a change of basis and compute it */
6661     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6662       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6663       if (PetscBTLookup(change_basis,total_counts)) {
6664         /* get constraint info */
6665         primal_dofs = constraints_n[total_counts];
6666         dual_dofs = size_of_constraint-primal_dofs;
6667 
6668         if (pcbddc->dbg_flag) {
6669           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);
6670         }
6671 
6672         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6673 
6674           /* copy quadrature constraints for change of basis check */
6675           if (pcbddc->dbg_flag) {
6676             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6677           }
6678           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6679           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6680 
6681           /* compute QR decomposition of constraints */
6682           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6683           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6684           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6685           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6686           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6687           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6688           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6689 
6690           /* explictly compute R^-T */
6691           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6692           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6693           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6694           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6695           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6696           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6697           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6698           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6699           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6700           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6701 
6702           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6703           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6704           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6705           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6706           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6707           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6708           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6709           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6710           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6711 
6712           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6713              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6714              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6715           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6716           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6717           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6718           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6719           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6720           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6721           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6722           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));
6723           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6724           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6725 
6726           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6727           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6728           /* insert cols for primal dofs */
6729           for (j=0;j<primal_dofs;j++) {
6730             start_vals = &qr_basis[j*size_of_constraint];
6731             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6732             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6733           }
6734           /* insert cols for dual dofs */
6735           for (j=0,k=0;j<dual_dofs;k++) {
6736             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6737               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6738               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6739               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6740               j++;
6741             }
6742           }
6743 
6744           /* check change of basis */
6745           if (pcbddc->dbg_flag) {
6746             PetscInt   ii,jj;
6747             PetscBool valid_qr=PETSC_TRUE;
6748             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6749             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6750             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6751             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6752             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6753             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6754             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6755             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));
6756             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6757             for (jj=0;jj<size_of_constraint;jj++) {
6758               for (ii=0;ii<primal_dofs;ii++) {
6759                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6760                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6761               }
6762             }
6763             if (!valid_qr) {
6764               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6765               for (jj=0;jj<size_of_constraint;jj++) {
6766                 for (ii=0;ii<primal_dofs;ii++) {
6767                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6768                     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);
6769                   }
6770                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6771                     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);
6772                   }
6773                 }
6774               }
6775             } else {
6776               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6777             }
6778           }
6779         } else { /* simple transformation block */
6780           PetscInt    row,col;
6781           PetscScalar val,norm;
6782 
6783           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6784           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6785           for (j=0;j<size_of_constraint;j++) {
6786             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6787             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6788             if (!PetscBTLookup(is_primal,row_B)) {
6789               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6790               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6791               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6792             } else {
6793               for (k=0;k<size_of_constraint;k++) {
6794                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6795                 if (row != col) {
6796                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6797                 } else {
6798                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6799                 }
6800                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6801               }
6802             }
6803           }
6804           if (pcbddc->dbg_flag) {
6805             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6806           }
6807         }
6808       } else {
6809         if (pcbddc->dbg_flag) {
6810           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6811         }
6812       }
6813     }
6814 
6815     /* free workspace */
6816     if (qr_needed) {
6817       if (pcbddc->dbg_flag) {
6818         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6819       }
6820       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6821       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6822       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6823       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6824       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6825     }
6826     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6827     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6828     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6829 
6830     /* assembling of global change of variable */
6831     if (!pcbddc->fake_change) {
6832       Mat      tmat;
6833       PetscInt bs;
6834 
6835       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6836       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6837       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6838       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6839       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6840       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6841       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6842       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6843       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6844       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6845       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6846       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6847       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6848       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6849       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6850       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6851       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6852       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6853       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6854       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6855 
6856       /* check */
6857       if (pcbddc->dbg_flag) {
6858         PetscReal error;
6859         Vec       x,x_change;
6860 
6861         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6862         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6863         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6864         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6865         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6866         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6867         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6868         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6869         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6870         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6871         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6872         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6873         if (error > PETSC_SMALL) {
6874           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6875         }
6876         ierr = VecDestroy(&x);CHKERRQ(ierr);
6877         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6878       }
6879       /* adapt sub_schurs computed (if any) */
6880       if (pcbddc->use_deluxe_scaling) {
6881         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6882 
6883         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");
6884         if (sub_schurs && sub_schurs->S_Ej_all) {
6885           Mat                    S_new,tmat;
6886           IS                     is_all_N,is_V_Sall = NULL;
6887 
6888           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6889           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6890           if (pcbddc->deluxe_zerorows) {
6891             ISLocalToGlobalMapping NtoSall;
6892             IS                     is_V;
6893             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6894             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6895             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6896             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6897             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6898           }
6899           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6900           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6901           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6902           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6903           if (pcbddc->deluxe_zerorows) {
6904             const PetscScalar *array;
6905             const PetscInt    *idxs_V,*idxs_all;
6906             PetscInt          i,n_V;
6907 
6908             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6909             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6910             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6911             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6912             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6913             for (i=0;i<n_V;i++) {
6914               PetscScalar val;
6915               PetscInt    idx;
6916 
6917               idx = idxs_V[i];
6918               val = array[idxs_all[idxs_V[i]]];
6919               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6920             }
6921             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6922             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6923             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6924             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6925             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6926           }
6927           sub_schurs->S_Ej_all = S_new;
6928           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6929           if (sub_schurs->sum_S_Ej_all) {
6930             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6931             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6932             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6933             if (pcbddc->deluxe_zerorows) {
6934               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6935             }
6936             sub_schurs->sum_S_Ej_all = S_new;
6937             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6938           }
6939           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6940           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6941         }
6942         /* destroy any change of basis context in sub_schurs */
6943         if (sub_schurs && sub_schurs->change) {
6944           PetscInt i;
6945 
6946           for (i=0;i<sub_schurs->n_subs;i++) {
6947             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6948           }
6949           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6950         }
6951       }
6952       if (pcbddc->switch_static) { /* need to save the local change */
6953         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6954       } else {
6955         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6956       }
6957       /* determine if any process has changed the pressures locally */
6958       pcbddc->change_interior = pcbddc->benign_have_null;
6959     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6960       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6961       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6962       pcbddc->use_qr_single = qr_needed;
6963     }
6964   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6965     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6966       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6967       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6968     } else {
6969       Mat benign_global = NULL;
6970       if (pcbddc->benign_have_null) {
6971         Mat M;
6972 
6973         pcbddc->change_interior = PETSC_TRUE;
6974         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6975         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6976         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6977         if (pcbddc->benign_change) {
6978           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6979           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6980         } else {
6981           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6982           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6983         }
6984         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6985         ierr = MatDestroy(&M);CHKERRQ(ierr);
6986         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6987         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6988       }
6989       if (pcbddc->user_ChangeOfBasisMatrix) {
6990         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6991         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6992       } else if (pcbddc->benign_have_null) {
6993         pcbddc->ChangeOfBasisMatrix = benign_global;
6994       }
6995     }
6996     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6997       IS             is_global;
6998       const PetscInt *gidxs;
6999 
7000       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7001       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7002       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7003       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7004       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7005     }
7006   }
7007   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7008     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7009   }
7010 
7011   if (!pcbddc->fake_change) {
7012     /* add pressure dofs to set of primal nodes for numbering purposes */
7013     for (i=0;i<pcbddc->benign_n;i++) {
7014       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7015       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7016       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7017       pcbddc->local_primal_size_cc++;
7018       pcbddc->local_primal_size++;
7019     }
7020 
7021     /* check if a new primal space has been introduced (also take into account benign trick) */
7022     pcbddc->new_primal_space_local = PETSC_TRUE;
7023     if (olocal_primal_size == pcbddc->local_primal_size) {
7024       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7025       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7026       if (!pcbddc->new_primal_space_local) {
7027         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7028         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7029       }
7030     }
7031     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7032     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7033   }
7034   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7035 
7036   /* flush dbg viewer */
7037   if (pcbddc->dbg_flag) {
7038     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7039   }
7040 
7041   /* free workspace */
7042   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7043   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7044   if (!pcbddc->adaptive_selection) {
7045     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7046     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7047   } else {
7048     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7049                       pcbddc->adaptive_constraints_idxs_ptr,
7050                       pcbddc->adaptive_constraints_data_ptr,
7051                       pcbddc->adaptive_constraints_idxs,
7052                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7053     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7054     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7055   }
7056   PetscFunctionReturn(0);
7057 }
7058 /* #undef PETSC_MISSING_LAPACK_GESVD */
7059 
7060 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7061 {
7062   ISLocalToGlobalMapping map;
7063   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7064   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7065   PetscInt               i,N;
7066   PetscBool              rcsr = PETSC_FALSE;
7067   PetscErrorCode         ierr;
7068 
7069   PetscFunctionBegin;
7070   if (pcbddc->recompute_topography) {
7071     pcbddc->graphanalyzed = PETSC_FALSE;
7072     /* Reset previously computed graph */
7073     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7074     /* Init local Graph struct */
7075     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7076     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7077     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7078 
7079     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7080       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7081     }
7082     /* Check validity of the csr graph passed in by the user */
7083     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);
7084 
7085     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7086     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7087       PetscInt  *xadj,*adjncy;
7088       PetscInt  nvtxs;
7089       PetscBool flg_row=PETSC_FALSE;
7090 
7091       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7092       if (flg_row) {
7093         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7094         pcbddc->computed_rowadj = PETSC_TRUE;
7095       }
7096       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7097       rcsr = PETSC_TRUE;
7098     }
7099     if (pcbddc->dbg_flag) {
7100       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7101     }
7102 
7103     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7104       PetscReal    *lcoords;
7105       PetscInt     n;
7106       MPI_Datatype dimrealtype;
7107 
7108       /* TODO: support for blocked */
7109       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);
7110       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7111       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7112       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7113       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7114       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7115       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7116       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7117       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7118 
7119       pcbddc->mat_graph->coords = lcoords;
7120       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7121       pcbddc->mat_graph->cnloc  = n;
7122     }
7123     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);
7124     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7125 
7126     /* Setup of Graph */
7127     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7128     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7129 
7130     /* attach info on disconnected subdomains if present */
7131     if (pcbddc->n_local_subs) {
7132       PetscInt *local_subs,n,totn;
7133 
7134       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7135       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7136       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7137       for (i=0;i<pcbddc->n_local_subs;i++) {
7138         const PetscInt *idxs;
7139         PetscInt       nl,j;
7140 
7141         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7142         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7143         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7144         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7145       }
7146       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7147       pcbddc->mat_graph->n_local_subs = totn + 1;
7148       pcbddc->mat_graph->local_subs = local_subs;
7149     }
7150   }
7151 
7152   if (!pcbddc->graphanalyzed) {
7153     /* Graph's connected components analysis */
7154     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7155     pcbddc->graphanalyzed = PETSC_TRUE;
7156     pcbddc->corner_selected = pcbddc->corner_selection;
7157   }
7158   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7159   PetscFunctionReturn(0);
7160 }
7161 
7162 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7163 {
7164   PetscInt       i,j;
7165   PetscScalar    *alphas;
7166   PetscReal      norm;
7167   PetscErrorCode ierr;
7168 
7169   PetscFunctionBegin;
7170   if (!n) PetscFunctionReturn(0);
7171   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7172   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7173   if (norm < PETSC_SMALL) {
7174     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7175   }
7176   for (i=1;i<n;i++) {
7177     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7178     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7179     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7180     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7181     if (norm < PETSC_SMALL) {
7182       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7183     }
7184   }
7185   ierr = PetscFree(alphas);CHKERRQ(ierr);
7186   PetscFunctionReturn(0);
7187 }
7188 
7189 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7190 {
7191   Mat            A;
7192   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7193   PetscMPIInt    size,rank,color;
7194   PetscInt       *xadj,*adjncy;
7195   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7196   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7197   PetscInt       void_procs,*procs_candidates = NULL;
7198   PetscInt       xadj_count,*count;
7199   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7200   PetscSubcomm   psubcomm;
7201   MPI_Comm       subcomm;
7202   PetscErrorCode ierr;
7203 
7204   PetscFunctionBegin;
7205   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7206   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7207   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);
7208   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7209   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7210   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7211 
7212   if (have_void) *have_void = PETSC_FALSE;
7213   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7214   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7215   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7216   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7217   im_active = !!n;
7218   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7219   void_procs = size - active_procs;
7220   /* get ranks of of non-active processes in mat communicator */
7221   if (void_procs) {
7222     PetscInt ncand;
7223 
7224     if (have_void) *have_void = PETSC_TRUE;
7225     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7226     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7227     for (i=0,ncand=0;i<size;i++) {
7228       if (!procs_candidates[i]) {
7229         procs_candidates[ncand++] = i;
7230       }
7231     }
7232     /* force n_subdomains to be not greater that the number of non-active processes */
7233     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7234   }
7235 
7236   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7237      number of subdomains requested 1 -> send to master or first candidate in voids  */
7238   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7239   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7240     PetscInt issize,isidx,dest;
7241     if (*n_subdomains == 1) dest = 0;
7242     else dest = rank;
7243     if (im_active) {
7244       issize = 1;
7245       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7246         isidx = procs_candidates[dest];
7247       } else {
7248         isidx = dest;
7249       }
7250     } else {
7251       issize = 0;
7252       isidx = -1;
7253     }
7254     if (*n_subdomains != 1) *n_subdomains = active_procs;
7255     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7256     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7257     PetscFunctionReturn(0);
7258   }
7259   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7260   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7261   threshold = PetscMax(threshold,2);
7262 
7263   /* Get info on mapping */
7264   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7265 
7266   /* build local CSR graph of subdomains' connectivity */
7267   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7268   xadj[0] = 0;
7269   xadj[1] = PetscMax(n_neighs-1,0);
7270   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7271   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7272   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7273   for (i=1;i<n_neighs;i++)
7274     for (j=0;j<n_shared[i];j++)
7275       count[shared[i][j]] += 1;
7276 
7277   xadj_count = 0;
7278   for (i=1;i<n_neighs;i++) {
7279     for (j=0;j<n_shared[i];j++) {
7280       if (count[shared[i][j]] < threshold) {
7281         adjncy[xadj_count] = neighs[i];
7282         adjncy_wgt[xadj_count] = n_shared[i];
7283         xadj_count++;
7284         break;
7285       }
7286     }
7287   }
7288   xadj[1] = xadj_count;
7289   ierr = PetscFree(count);CHKERRQ(ierr);
7290   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7291   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7292 
7293   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7294 
7295   /* Restrict work on active processes only */
7296   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7297   if (void_procs) {
7298     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7299     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7300     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7301     subcomm = PetscSubcommChild(psubcomm);
7302   } else {
7303     psubcomm = NULL;
7304     subcomm = PetscObjectComm((PetscObject)mat);
7305   }
7306 
7307   v_wgt = NULL;
7308   if (!color) {
7309     ierr = PetscFree(xadj);CHKERRQ(ierr);
7310     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7311     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7312   } else {
7313     Mat             subdomain_adj;
7314     IS              new_ranks,new_ranks_contig;
7315     MatPartitioning partitioner;
7316     PetscInt        rstart=0,rend=0;
7317     PetscInt        *is_indices,*oldranks;
7318     PetscMPIInt     size;
7319     PetscBool       aggregate;
7320 
7321     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7322     if (void_procs) {
7323       PetscInt prank = rank;
7324       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7325       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7326       for (i=0;i<xadj[1];i++) {
7327         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7328       }
7329       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7330     } else {
7331       oldranks = NULL;
7332     }
7333     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7334     if (aggregate) { /* TODO: all this part could be made more efficient */
7335       PetscInt    lrows,row,ncols,*cols;
7336       PetscMPIInt nrank;
7337       PetscScalar *vals;
7338 
7339       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7340       lrows = 0;
7341       if (nrank<redprocs) {
7342         lrows = size/redprocs;
7343         if (nrank<size%redprocs) lrows++;
7344       }
7345       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7346       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7347       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7348       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7349       row = nrank;
7350       ncols = xadj[1]-xadj[0];
7351       cols = adjncy;
7352       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7353       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7354       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7355       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7356       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7357       ierr = PetscFree(xadj);CHKERRQ(ierr);
7358       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7359       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7360       ierr = PetscFree(vals);CHKERRQ(ierr);
7361       if (use_vwgt) {
7362         Vec               v;
7363         const PetscScalar *array;
7364         PetscInt          nl;
7365 
7366         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7367         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7368         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7369         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7370         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7371         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7372         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7373         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7374         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7375         ierr = VecDestroy(&v);CHKERRQ(ierr);
7376       }
7377     } else {
7378       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7379       if (use_vwgt) {
7380         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7381         v_wgt[0] = n;
7382       }
7383     }
7384     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7385 
7386     /* Partition */
7387     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7388 #if defined(PETSC_HAVE_PTSCOTCH)
7389     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7390 #elif defined(PETSC_HAVE_PARMETIS)
7391     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7392 #else
7393     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7394 #endif
7395     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7396     if (v_wgt) {
7397       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7398     }
7399     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7400     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7401     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7402     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7403     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7404 
7405     /* renumber new_ranks to avoid "holes" in new set of processors */
7406     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7407     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7408     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7409     if (!aggregate) {
7410       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7411 #if defined(PETSC_USE_DEBUG)
7412         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7413 #endif
7414         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7415       } else if (oldranks) {
7416         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7417       } else {
7418         ranks_send_to_idx[0] = is_indices[0];
7419       }
7420     } else {
7421       PetscInt    idx = 0;
7422       PetscMPIInt tag;
7423       MPI_Request *reqs;
7424 
7425       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7426       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7427       for (i=rstart;i<rend;i++) {
7428         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7429       }
7430       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7431       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7432       ierr = PetscFree(reqs);CHKERRQ(ierr);
7433       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7434 #if defined(PETSC_USE_DEBUG)
7435         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7436 #endif
7437         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7438       } else if (oldranks) {
7439         ranks_send_to_idx[0] = oldranks[idx];
7440       } else {
7441         ranks_send_to_idx[0] = idx;
7442       }
7443     }
7444     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7445     /* clean up */
7446     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7447     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7448     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7449     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7450   }
7451   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7452   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7453 
7454   /* assemble parallel IS for sends */
7455   i = 1;
7456   if (!color) i=0;
7457   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7458   PetscFunctionReturn(0);
7459 }
7460 
7461 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7462 
7463 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[])
7464 {
7465   Mat                    local_mat;
7466   IS                     is_sends_internal;
7467   PetscInt               rows,cols,new_local_rows;
7468   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7469   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7470   ISLocalToGlobalMapping l2gmap;
7471   PetscInt*              l2gmap_indices;
7472   const PetscInt*        is_indices;
7473   MatType                new_local_type;
7474   /* buffers */
7475   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7476   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7477   PetscInt               *recv_buffer_idxs_local;
7478   PetscScalar            *ptr_vals,*recv_buffer_vals;
7479   const PetscScalar      *send_buffer_vals;
7480   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7481   /* MPI */
7482   MPI_Comm               comm,comm_n;
7483   PetscSubcomm           subcomm;
7484   PetscMPIInt            n_sends,n_recvs,size;
7485   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7486   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7487   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7488   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7489   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7490   PetscErrorCode         ierr;
7491 
7492   PetscFunctionBegin;
7493   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7494   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7495   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);
7496   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7497   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7498   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7499   PetscValidLogicalCollectiveBool(mat,reuse,6);
7500   PetscValidLogicalCollectiveInt(mat,nis,8);
7501   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7502   if (nvecs) {
7503     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7504     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7505   }
7506   /* further checks */
7507   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7508   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7509   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7510   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7511   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7512   if (reuse && *mat_n) {
7513     PetscInt mrows,mcols,mnrows,mncols;
7514     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7515     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7516     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7517     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7518     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7519     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7520     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7521   }
7522   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7523   PetscValidLogicalCollectiveInt(mat,bs,0);
7524 
7525   /* prepare IS for sending if not provided */
7526   if (!is_sends) {
7527     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7528     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7529   } else {
7530     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7531     is_sends_internal = is_sends;
7532   }
7533 
7534   /* get comm */
7535   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7536 
7537   /* compute number of sends */
7538   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7539   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7540 
7541   /* compute number of receives */
7542   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7543   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7544   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7545   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7546   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7547   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7548   ierr = PetscFree(iflags);CHKERRQ(ierr);
7549 
7550   /* restrict comm if requested */
7551   subcomm = 0;
7552   destroy_mat = PETSC_FALSE;
7553   if (restrict_comm) {
7554     PetscMPIInt color,subcommsize;
7555 
7556     color = 0;
7557     if (restrict_full) {
7558       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7559     } else {
7560       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7561     }
7562     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7563     subcommsize = size - subcommsize;
7564     /* check if reuse has been requested */
7565     if (reuse) {
7566       if (*mat_n) {
7567         PetscMPIInt subcommsize2;
7568         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7569         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7570         comm_n = PetscObjectComm((PetscObject)*mat_n);
7571       } else {
7572         comm_n = PETSC_COMM_SELF;
7573       }
7574     } else { /* MAT_INITIAL_MATRIX */
7575       PetscMPIInt rank;
7576 
7577       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7578       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7579       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7580       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7581       comm_n = PetscSubcommChild(subcomm);
7582     }
7583     /* flag to destroy *mat_n if not significative */
7584     if (color) destroy_mat = PETSC_TRUE;
7585   } else {
7586     comm_n = comm;
7587   }
7588 
7589   /* prepare send/receive buffers */
7590   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7591   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7592   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7593   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7594   if (nis) {
7595     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7596   }
7597 
7598   /* Get data from local matrices */
7599   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7600     /* TODO: See below some guidelines on how to prepare the local buffers */
7601     /*
7602        send_buffer_vals should contain the raw values of the local matrix
7603        send_buffer_idxs should contain:
7604        - MatType_PRIVATE type
7605        - PetscInt        size_of_l2gmap
7606        - PetscInt        global_row_indices[size_of_l2gmap]
7607        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7608     */
7609   else {
7610     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7611     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7612     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7613     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7614     send_buffer_idxs[1] = i;
7615     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7616     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7617     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7618     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7619     for (i=0;i<n_sends;i++) {
7620       ilengths_vals[is_indices[i]] = len*len;
7621       ilengths_idxs[is_indices[i]] = len+2;
7622     }
7623   }
7624   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7625   /* additional is (if any) */
7626   if (nis) {
7627     PetscMPIInt psum;
7628     PetscInt j;
7629     for (j=0,psum=0;j<nis;j++) {
7630       PetscInt plen;
7631       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7632       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7633       psum += len+1; /* indices + lenght */
7634     }
7635     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7636     for (j=0,psum=0;j<nis;j++) {
7637       PetscInt plen;
7638       const PetscInt *is_array_idxs;
7639       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7640       send_buffer_idxs_is[psum] = plen;
7641       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7642       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7643       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7644       psum += plen+1; /* indices + lenght */
7645     }
7646     for (i=0;i<n_sends;i++) {
7647       ilengths_idxs_is[is_indices[i]] = psum;
7648     }
7649     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7650   }
7651   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7652 
7653   buf_size_idxs = 0;
7654   buf_size_vals = 0;
7655   buf_size_idxs_is = 0;
7656   buf_size_vecs = 0;
7657   for (i=0;i<n_recvs;i++) {
7658     buf_size_idxs += (PetscInt)olengths_idxs[i];
7659     buf_size_vals += (PetscInt)olengths_vals[i];
7660     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7661     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7662   }
7663   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7664   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7665   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7666   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7667 
7668   /* get new tags for clean communications */
7669   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7670   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7671   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7672   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7673 
7674   /* allocate for requests */
7675   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7676   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7677   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7678   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7679   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7680   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7681   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7682   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7683 
7684   /* communications */
7685   ptr_idxs = recv_buffer_idxs;
7686   ptr_vals = recv_buffer_vals;
7687   ptr_idxs_is = recv_buffer_idxs_is;
7688   ptr_vecs = recv_buffer_vecs;
7689   for (i=0;i<n_recvs;i++) {
7690     source_dest = onodes[i];
7691     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7692     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7693     ptr_idxs += olengths_idxs[i];
7694     ptr_vals += olengths_vals[i];
7695     if (nis) {
7696       source_dest = onodes_is[i];
7697       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);
7698       ptr_idxs_is += olengths_idxs_is[i];
7699     }
7700     if (nvecs) {
7701       source_dest = onodes[i];
7702       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7703       ptr_vecs += olengths_idxs[i]-2;
7704     }
7705   }
7706   for (i=0;i<n_sends;i++) {
7707     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7708     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7709     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7710     if (nis) {
7711       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);
7712     }
7713     if (nvecs) {
7714       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7715       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7716     }
7717   }
7718   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7719   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7720 
7721   /* assemble new l2g map */
7722   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7723   ptr_idxs = recv_buffer_idxs;
7724   new_local_rows = 0;
7725   for (i=0;i<n_recvs;i++) {
7726     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7727     ptr_idxs += olengths_idxs[i];
7728   }
7729   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7730   ptr_idxs = recv_buffer_idxs;
7731   new_local_rows = 0;
7732   for (i=0;i<n_recvs;i++) {
7733     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7734     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7735     ptr_idxs += olengths_idxs[i];
7736   }
7737   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7738   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7739   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7740 
7741   /* infer new local matrix type from received local matrices type */
7742   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7743   /* 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) */
7744   if (n_recvs) {
7745     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7746     ptr_idxs = recv_buffer_idxs;
7747     for (i=0;i<n_recvs;i++) {
7748       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7749         new_local_type_private = MATAIJ_PRIVATE;
7750         break;
7751       }
7752       ptr_idxs += olengths_idxs[i];
7753     }
7754     switch (new_local_type_private) {
7755       case MATDENSE_PRIVATE:
7756         new_local_type = MATSEQAIJ;
7757         bs = 1;
7758         break;
7759       case MATAIJ_PRIVATE:
7760         new_local_type = MATSEQAIJ;
7761         bs = 1;
7762         break;
7763       case MATBAIJ_PRIVATE:
7764         new_local_type = MATSEQBAIJ;
7765         break;
7766       case MATSBAIJ_PRIVATE:
7767         new_local_type = MATSEQSBAIJ;
7768         break;
7769       default:
7770         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7771         break;
7772     }
7773   } else { /* by default, new_local_type is seqaij */
7774     new_local_type = MATSEQAIJ;
7775     bs = 1;
7776   }
7777 
7778   /* create MATIS object if needed */
7779   if (!reuse) {
7780     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7781     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7782   } else {
7783     /* it also destroys the local matrices */
7784     if (*mat_n) {
7785       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7786     } else { /* this is a fake object */
7787       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7788     }
7789   }
7790   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7791   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7792 
7793   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7794 
7795   /* Global to local map of received indices */
7796   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7797   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7798   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7799 
7800   /* restore attributes -> type of incoming data and its size */
7801   buf_size_idxs = 0;
7802   for (i=0;i<n_recvs;i++) {
7803     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7804     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7805     buf_size_idxs += (PetscInt)olengths_idxs[i];
7806   }
7807   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7808 
7809   /* set preallocation */
7810   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7811   if (!newisdense) {
7812     PetscInt *new_local_nnz=0;
7813 
7814     ptr_idxs = recv_buffer_idxs_local;
7815     if (n_recvs) {
7816       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7817     }
7818     for (i=0;i<n_recvs;i++) {
7819       PetscInt j;
7820       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7821         for (j=0;j<*(ptr_idxs+1);j++) {
7822           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7823         }
7824       } else {
7825         /* TODO */
7826       }
7827       ptr_idxs += olengths_idxs[i];
7828     }
7829     if (new_local_nnz) {
7830       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7831       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7832       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7833       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7834       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7835       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7836     } else {
7837       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7838     }
7839     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7840   } else {
7841     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7842   }
7843 
7844   /* set values */
7845   ptr_vals = recv_buffer_vals;
7846   ptr_idxs = recv_buffer_idxs_local;
7847   for (i=0;i<n_recvs;i++) {
7848     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7849       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7850       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7851       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7852       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7853       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7854     } else {
7855       /* TODO */
7856     }
7857     ptr_idxs += olengths_idxs[i];
7858     ptr_vals += olengths_vals[i];
7859   }
7860   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7861   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7862   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7863   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7864   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7865   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7866 
7867 #if 0
7868   if (!restrict_comm) { /* check */
7869     Vec       lvec,rvec;
7870     PetscReal infty_error;
7871 
7872     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7873     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7874     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7875     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7876     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7877     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7878     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7879     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7880     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7881   }
7882 #endif
7883 
7884   /* assemble new additional is (if any) */
7885   if (nis) {
7886     PetscInt **temp_idxs,*count_is,j,psum;
7887 
7888     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7889     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7890     ptr_idxs = recv_buffer_idxs_is;
7891     psum = 0;
7892     for (i=0;i<n_recvs;i++) {
7893       for (j=0;j<nis;j++) {
7894         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7895         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7896         psum += plen;
7897         ptr_idxs += plen+1; /* shift pointer to received data */
7898       }
7899     }
7900     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7901     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7902     for (i=1;i<nis;i++) {
7903       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7904     }
7905     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
7906     ptr_idxs = recv_buffer_idxs_is;
7907     for (i=0;i<n_recvs;i++) {
7908       for (j=0;j<nis;j++) {
7909         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7910         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
7911         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7912         ptr_idxs += plen+1; /* shift pointer to received data */
7913       }
7914     }
7915     for (i=0;i<nis;i++) {
7916       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7917       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7918       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7919     }
7920     ierr = PetscFree(count_is);CHKERRQ(ierr);
7921     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7922     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7923   }
7924   /* free workspace */
7925   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7926   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7927   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7928   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7929   if (isdense) {
7930     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7931     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7932     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7933   } else {
7934     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7935   }
7936   if (nis) {
7937     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7938     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7939   }
7940 
7941   if (nvecs) {
7942     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7943     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7944     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7945     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7946     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7947     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7948     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7949     /* set values */
7950     ptr_vals = recv_buffer_vecs;
7951     ptr_idxs = recv_buffer_idxs_local;
7952     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7953     for (i=0;i<n_recvs;i++) {
7954       PetscInt j;
7955       for (j=0;j<*(ptr_idxs+1);j++) {
7956         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7957       }
7958       ptr_idxs += olengths_idxs[i];
7959       ptr_vals += olengths_idxs[i]-2;
7960     }
7961     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7962     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7963     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7964   }
7965 
7966   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7967   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7968   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7969   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7970   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7971   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7972   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7973   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7974   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7975   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7976   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7977   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7978   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7979   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7980   ierr = PetscFree(onodes);CHKERRQ(ierr);
7981   if (nis) {
7982     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7983     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7984     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7985   }
7986   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7987   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7988     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7989     for (i=0;i<nis;i++) {
7990       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7991     }
7992     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7993       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7994     }
7995     *mat_n = NULL;
7996   }
7997   PetscFunctionReturn(0);
7998 }
7999 
8000 /* temporary hack into ksp private data structure */
8001 #include <petsc/private/kspimpl.h>
8002 
8003 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8004 {
8005   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8006   PC_IS                  *pcis = (PC_IS*)pc->data;
8007   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8008   Mat                    coarsedivudotp = NULL;
8009   Mat                    coarseG,t_coarse_mat_is;
8010   MatNullSpace           CoarseNullSpace = NULL;
8011   ISLocalToGlobalMapping coarse_islg;
8012   IS                     coarse_is,*isarray,corners;
8013   PetscInt               i,im_active=-1,active_procs=-1;
8014   PetscInt               nis,nisdofs,nisneu,nisvert;
8015   PetscInt               coarse_eqs_per_proc;
8016   PC                     pc_temp;
8017   PCType                 coarse_pc_type;
8018   KSPType                coarse_ksp_type;
8019   PetscBool              multilevel_requested,multilevel_allowed;
8020   PetscBool              coarse_reuse;
8021   PetscInt               ncoarse,nedcfield;
8022   PetscBool              compute_vecs = PETSC_FALSE;
8023   PetscScalar            *array;
8024   MatReuse               coarse_mat_reuse;
8025   PetscBool              restr, full_restr, have_void;
8026   PetscMPIInt            size;
8027   PetscErrorCode         ierr;
8028 
8029   PetscFunctionBegin;
8030   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8031   /* Assign global numbering to coarse dofs */
8032   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 */
8033     PetscInt ocoarse_size;
8034     compute_vecs = PETSC_TRUE;
8035 
8036     pcbddc->new_primal_space = PETSC_TRUE;
8037     ocoarse_size = pcbddc->coarse_size;
8038     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8039     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8040     /* see if we can avoid some work */
8041     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8042       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8043       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8044         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8045         coarse_reuse = PETSC_FALSE;
8046       } else { /* we can safely reuse already computed coarse matrix */
8047         coarse_reuse = PETSC_TRUE;
8048       }
8049     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8050       coarse_reuse = PETSC_FALSE;
8051     }
8052     /* reset any subassembling information */
8053     if (!coarse_reuse || pcbddc->recompute_topography) {
8054       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8055     }
8056   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8057     coarse_reuse = PETSC_TRUE;
8058   }
8059   if (coarse_reuse && pcbddc->coarse_ksp) {
8060     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8061     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8062     coarse_mat_reuse = MAT_REUSE_MATRIX;
8063   } else {
8064     coarse_mat = NULL;
8065     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8066   }
8067 
8068   /* creates temporary l2gmap and IS for coarse indexes */
8069   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8070   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8071 
8072   /* creates temporary MATIS object for coarse matrix */
8073   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8074   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);
8075   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8076   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8077   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8078   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8079 
8080   /* count "active" (i.e. with positive local size) and "void" processes */
8081   im_active = !!(pcis->n);
8082   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8083 
8084   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8085   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8086   /* full_restr : just use the receivers from the subassembling pattern */
8087   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8088   coarse_mat_is        = NULL;
8089   multilevel_allowed   = PETSC_FALSE;
8090   multilevel_requested = PETSC_FALSE;
8091   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8092   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8093   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8094   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8095   if (multilevel_requested) {
8096     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8097     restr      = PETSC_FALSE;
8098     full_restr = PETSC_FALSE;
8099   } else {
8100     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8101     restr      = PETSC_TRUE;
8102     full_restr = PETSC_TRUE;
8103   }
8104   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8105   ncoarse = PetscMax(1,ncoarse);
8106   if (!pcbddc->coarse_subassembling) {
8107     if (pcbddc->coarsening_ratio > 1) {
8108       if (multilevel_requested) {
8109         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8110       } else {
8111         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8112       }
8113     } else {
8114       PetscMPIInt rank;
8115       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8116       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8117       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8118     }
8119   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8120     PetscInt    psum;
8121     if (pcbddc->coarse_ksp) psum = 1;
8122     else psum = 0;
8123     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8124     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8125   }
8126   /* determine if we can go multilevel */
8127   if (multilevel_requested) {
8128     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8129     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8130   }
8131   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8132 
8133   /* dump subassembling pattern */
8134   if (pcbddc->dbg_flag && multilevel_allowed) {
8135     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8136   }
8137   /* compute dofs splitting and neumann boundaries for coarse dofs */
8138   nedcfield = -1;
8139   corners = NULL;
8140   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneded computations */
8141     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8142     const PetscInt         *idxs;
8143     ISLocalToGlobalMapping tmap;
8144 
8145     /* create map between primal indices (in local representative ordering) and local primal numbering */
8146     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8147     /* allocate space for temporary storage */
8148     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8149     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8150     /* allocate for IS array */
8151     nisdofs = pcbddc->n_ISForDofsLocal;
8152     if (pcbddc->nedclocal) {
8153       if (pcbddc->nedfield > -1) {
8154         nedcfield = pcbddc->nedfield;
8155       } else {
8156         nedcfield = 0;
8157         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8158         nisdofs = 1;
8159       }
8160     }
8161     nisneu = !!pcbddc->NeumannBoundariesLocal;
8162     nisvert = 0; /* nisvert is not used */
8163     nis = nisdofs + nisneu + nisvert;
8164     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8165     /* dofs splitting */
8166     for (i=0;i<nisdofs;i++) {
8167       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8168       if (nedcfield != i) {
8169         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8170         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8171         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8172         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8173       } else {
8174         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8175         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8176         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8177         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8178         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8179       }
8180       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8181       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8182       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8183     }
8184     /* neumann boundaries */
8185     if (pcbddc->NeumannBoundariesLocal) {
8186       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8187       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8188       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8189       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8190       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8191       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8192       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8193       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8194     }
8195     /* coordinates */
8196     if (pcbddc->corner_selected) {
8197       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8198       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8199       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8200       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8201       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8202       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8203       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8204       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8205       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8206     }
8207     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8208     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8209     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8210   } else {
8211     nis = 0;
8212     nisdofs = 0;
8213     nisneu = 0;
8214     nisvert = 0;
8215     isarray = NULL;
8216   }
8217   /* destroy no longer needed map */
8218   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8219 
8220   /* subassemble */
8221   if (multilevel_allowed) {
8222     Vec       vp[1];
8223     PetscInt  nvecs = 0;
8224     PetscBool reuse,reuser;
8225 
8226     if (coarse_mat) reuse = PETSC_TRUE;
8227     else reuse = PETSC_FALSE;
8228     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8229     vp[0] = NULL;
8230     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8231       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8232       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8233       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8234       nvecs = 1;
8235 
8236       if (pcbddc->divudotp) {
8237         Mat      B,loc_divudotp;
8238         Vec      v,p;
8239         IS       dummy;
8240         PetscInt np;
8241 
8242         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8243         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8244         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8245         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8246         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8247         ierr = VecSet(p,1.);CHKERRQ(ierr);
8248         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8249         ierr = VecDestroy(&p);CHKERRQ(ierr);
8250         ierr = MatDestroy(&B);CHKERRQ(ierr);
8251         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8252         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8253         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8254         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8255         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8256         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8257         ierr = VecDestroy(&v);CHKERRQ(ierr);
8258       }
8259     }
8260     if (reuser) {
8261       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8262     } else {
8263       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8264     }
8265     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8266       PetscScalar       *arraym;
8267       const PetscScalar *arrayv;
8268       PetscInt          nl;
8269       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8270       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8271       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8272       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8273       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8274       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8275       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8276       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8277     } else {
8278       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8279     }
8280   } else {
8281     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8282   }
8283   if (coarse_mat_is || coarse_mat) {
8284     if (!multilevel_allowed) {
8285       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8286     } else {
8287       Mat A;
8288 
8289       /* if this matrix is present, it means we are not reusing the coarse matrix */
8290       if (coarse_mat_is) {
8291         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8292         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8293         coarse_mat = coarse_mat_is;
8294       }
8295       /* be sure we don't have MatSeqDENSE as local mat */
8296       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8297       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8298     }
8299   }
8300   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8301   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8302 
8303   /* create local to global scatters for coarse problem */
8304   if (compute_vecs) {
8305     PetscInt lrows;
8306     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8307     if (coarse_mat) {
8308       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8309     } else {
8310       lrows = 0;
8311     }
8312     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8313     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8314     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8315     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8316     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8317   }
8318   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8319 
8320   /* set defaults for coarse KSP and PC */
8321   if (multilevel_allowed) {
8322     coarse_ksp_type = KSPRICHARDSON;
8323     coarse_pc_type  = PCBDDC;
8324   } else {
8325     coarse_ksp_type = KSPPREONLY;
8326     coarse_pc_type  = PCREDUNDANT;
8327   }
8328 
8329   /* print some info if requested */
8330   if (pcbddc->dbg_flag) {
8331     if (!multilevel_allowed) {
8332       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8333       if (multilevel_requested) {
8334         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);
8335       } else if (pcbddc->max_levels) {
8336         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8337       }
8338       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8339     }
8340   }
8341 
8342   /* communicate coarse discrete gradient */
8343   coarseG = NULL;
8344   if (pcbddc->nedcG && multilevel_allowed) {
8345     MPI_Comm ccomm;
8346     if (coarse_mat) {
8347       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8348     } else {
8349       ccomm = MPI_COMM_NULL;
8350     }
8351     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8352   }
8353 
8354   /* create the coarse KSP object only once with defaults */
8355   if (coarse_mat) {
8356     PetscBool   isredundant,isnn,isbddc;
8357     PetscViewer dbg_viewer = NULL;
8358 
8359     if (pcbddc->dbg_flag) {
8360       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8361       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8362     }
8363     if (!pcbddc->coarse_ksp) {
8364       char   prefix[256],str_level[16];
8365       size_t len;
8366 
8367       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8368       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8369       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8370       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8371       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8372       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8373       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8374       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8375       /* TODO is this logic correct? should check for coarse_mat type */
8376       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8377       /* prefix */
8378       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8379       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8380       if (!pcbddc->current_level) {
8381         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8382         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8383       } else {
8384         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8385         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8386         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8387         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8388         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8389         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8390         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8391       }
8392       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8393       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8394       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8395       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8396       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8397       /* allow user customization */
8398       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8399       /* get some info after set from options */
8400       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8401       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8402       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8403       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8404       if (multilevel_allowed && !isbddc && !isnn) {
8405         isbddc = PETSC_TRUE;
8406         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8407         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8408         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8409         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8410         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8411           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8412           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8413           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8414           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8415           pc_temp->setfromoptionscalled++;
8416         }
8417       }
8418     }
8419     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8420     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8421     if (nisdofs) {
8422       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8423       for (i=0;i<nisdofs;i++) {
8424         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8425       }
8426     }
8427     if (nisneu) {
8428       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8429       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8430     }
8431     if (nisvert) {
8432       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8433       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8434     }
8435     if (coarseG) {
8436       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8437     }
8438 
8439     /* get some info after set from options */
8440     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8441 
8442     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8443     if (isbddc && !multilevel_allowed) {
8444       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8445       isbddc = PETSC_FALSE;
8446     }
8447     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8448     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8449     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8450       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8451       isbddc = PETSC_TRUE;
8452     }
8453     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8454     if (isredundant) {
8455       KSP inner_ksp;
8456       PC  inner_pc;
8457 
8458       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8459       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8460     }
8461 
8462     /* parameters which miss an API */
8463     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8464     if (isbddc) {
8465       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8466 
8467       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8468       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8469       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8470       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8471       if (pcbddc_coarse->benign_saddle_point) {
8472         Mat                    coarsedivudotp_is;
8473         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8474         IS                     row,col;
8475         const PetscInt         *gidxs;
8476         PetscInt               n,st,M,N;
8477 
8478         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8479         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8480         st   = st-n;
8481         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8482         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8483         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8484         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8485         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8486         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8487         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8488         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8489         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8490         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8491         ierr = ISDestroy(&row);CHKERRQ(ierr);
8492         ierr = ISDestroy(&col);CHKERRQ(ierr);
8493         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8494         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8495         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8496         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8497         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8498         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8499         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8500         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8501         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8502         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8503         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8504         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8505       }
8506     }
8507 
8508     /* propagate symmetry info of coarse matrix */
8509     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8510     if (pc->pmat->symmetric_set) {
8511       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8512     }
8513     if (pc->pmat->hermitian_set) {
8514       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8515     }
8516     if (pc->pmat->spd_set) {
8517       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8518     }
8519     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8520       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8521     }
8522     /* set operators */
8523     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8524     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8525     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8526     if (pcbddc->dbg_flag) {
8527       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8528     }
8529   }
8530   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8531   ierr = PetscFree(isarray);CHKERRQ(ierr);
8532 #if 0
8533   {
8534     PetscViewer viewer;
8535     char filename[256];
8536     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8537     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8538     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8539     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8540     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8541     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8542   }
8543 #endif
8544 
8545   if (corners) {
8546     Vec            gv;
8547     IS             is;
8548     const PetscInt *idxs;
8549     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8550     PetscScalar    *coords;
8551 
8552     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8553     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8554     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8555     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8556     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8557     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8558     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8559     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8560     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8561 
8562     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8563     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8564     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8565     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8566     for (i=0;i<n;i++) {
8567       for (d=0;d<cdim;d++) {
8568         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8569       }
8570     }
8571     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8572     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8573 
8574     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8575     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8576     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8577     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8578     ierr = PetscFree(coords);CHKERRQ(ierr);
8579     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8580     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8581     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8582     if (pcbddc->coarse_ksp) {
8583       PC        coarse_pc;
8584       PetscBool isbddc;
8585 
8586       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8587       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8588       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8589         PetscReal *realcoords;
8590 
8591         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8592 #if defined(PETSC_USE_COMPLEX)
8593         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8594         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8595 #else
8596         realcoords = coords;
8597 #endif
8598         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8599 #if defined(PETSC_USE_COMPLEX)
8600         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8601 #endif
8602       }
8603     }
8604     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8605     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8606   }
8607   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8608 
8609   if (pcbddc->coarse_ksp) {
8610     Vec crhs,csol;
8611 
8612     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8613     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8614     if (!csol) {
8615       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8616     }
8617     if (!crhs) {
8618       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8619     }
8620   }
8621   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8622 
8623   /* compute null space for coarse solver if the benign trick has been requested */
8624   if (pcbddc->benign_null) {
8625 
8626     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8627     for (i=0;i<pcbddc->benign_n;i++) {
8628       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8629     }
8630     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8631     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8632     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8633     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8634     if (coarse_mat) {
8635       Vec         nullv;
8636       PetscScalar *array,*array2;
8637       PetscInt    nl;
8638 
8639       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8640       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8641       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8642       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8643       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8644       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8645       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8646       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8647       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8648       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8649     }
8650   }
8651   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8652 
8653   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8654   if (pcbddc->coarse_ksp) {
8655     PetscBool ispreonly;
8656 
8657     if (CoarseNullSpace) {
8658       PetscBool isnull;
8659       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8660       if (isnull) {
8661         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8662       }
8663       /* TODO: add local nullspaces (if any) */
8664     }
8665     /* setup coarse ksp */
8666     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8667     /* Check coarse problem if in debug mode or if solving with an iterative method */
8668     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8669     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8670       KSP       check_ksp;
8671       KSPType   check_ksp_type;
8672       PC        check_pc;
8673       Vec       check_vec,coarse_vec;
8674       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8675       PetscInt  its;
8676       PetscBool compute_eigs;
8677       PetscReal *eigs_r,*eigs_c;
8678       PetscInt  neigs;
8679       const char *prefix;
8680 
8681       /* Create ksp object suitable for estimation of extreme eigenvalues */
8682       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8683       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8684       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8685       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8686       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8687       /* prevent from setup unneeded object */
8688       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8689       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8690       if (ispreonly) {
8691         check_ksp_type = KSPPREONLY;
8692         compute_eigs = PETSC_FALSE;
8693       } else {
8694         check_ksp_type = KSPGMRES;
8695         compute_eigs = PETSC_TRUE;
8696       }
8697       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8698       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8699       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8700       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8701       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8702       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8703       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8704       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8705       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8706       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8707       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8708       /* create random vec */
8709       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8710       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8711       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8712       /* solve coarse problem */
8713       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8714       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8715       /* set eigenvalue estimation if preonly has not been requested */
8716       if (compute_eigs) {
8717         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8718         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8719         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8720         if (neigs) {
8721           lambda_max = eigs_r[neigs-1];
8722           lambda_min = eigs_r[0];
8723           if (pcbddc->use_coarse_estimates) {
8724             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8725               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8726               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8727             }
8728           }
8729         }
8730       }
8731 
8732       /* check coarse problem residual error */
8733       if (pcbddc->dbg_flag) {
8734         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8735         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8736         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8737         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8738         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8739         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8740         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8741         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8742         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8743         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8744         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8745         if (CoarseNullSpace) {
8746           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8747         }
8748         if (compute_eigs) {
8749           PetscReal          lambda_max_s,lambda_min_s;
8750           KSPConvergedReason reason;
8751           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8752           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8753           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8754           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8755           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);
8756           for (i=0;i<neigs;i++) {
8757             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8758           }
8759         }
8760         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8761         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8762       }
8763       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8764       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8765       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8766       if (compute_eigs) {
8767         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8768         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8769       }
8770     }
8771   }
8772   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8773   /* print additional info */
8774   if (pcbddc->dbg_flag) {
8775     /* waits until all processes reaches this point */
8776     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8777     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8778     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8779   }
8780 
8781   /* free memory */
8782   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8783   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8784   PetscFunctionReturn(0);
8785 }
8786 
8787 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8788 {
8789   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8790   PC_IS*         pcis = (PC_IS*)pc->data;
8791   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8792   IS             subset,subset_mult,subset_n;
8793   PetscInt       local_size,coarse_size=0;
8794   PetscInt       *local_primal_indices=NULL;
8795   const PetscInt *t_local_primal_indices;
8796   PetscErrorCode ierr;
8797 
8798   PetscFunctionBegin;
8799   /* Compute global number of coarse dofs */
8800   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8801   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8802   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8803   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8804   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8805   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8806   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8807   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8808   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8809   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);
8810   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8811   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8812   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8813   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8814   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8815 
8816   /* check numbering */
8817   if (pcbddc->dbg_flag) {
8818     PetscScalar coarsesum,*array,*array2;
8819     PetscInt    i;
8820     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8821 
8822     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8823     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8824     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8825     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8826     /* counter */
8827     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8828     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8829     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8830     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8831     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8832     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8833     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8834     for (i=0;i<pcbddc->local_primal_size;i++) {
8835       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8836     }
8837     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8838     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8839     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8840     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8841     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8842     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8843     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8844     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8845     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8846     for (i=0;i<pcis->n;i++) {
8847       if (array[i] != 0.0 && array[i] != array2[i]) {
8848         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8849         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8850         set_error = PETSC_TRUE;
8851         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8852         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);
8853       }
8854     }
8855     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8856     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8857     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8858     for (i=0;i<pcis->n;i++) {
8859       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8860     }
8861     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8862     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8863     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8864     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8865     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8866     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8867     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8868       PetscInt *gidxs;
8869 
8870       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8871       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8872       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8873       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8874       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8875       for (i=0;i<pcbddc->local_primal_size;i++) {
8876         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);
8877       }
8878       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8879       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8880     }
8881     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8882     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8883     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8884   }
8885 
8886   /* get back data */
8887   *coarse_size_n = coarse_size;
8888   *local_primal_indices_n = local_primal_indices;
8889   PetscFunctionReturn(0);
8890 }
8891 
8892 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8893 {
8894   IS             localis_t;
8895   PetscInt       i,lsize,*idxs,n;
8896   PetscScalar    *vals;
8897   PetscErrorCode ierr;
8898 
8899   PetscFunctionBegin;
8900   /* get indices in local ordering exploiting local to global map */
8901   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8902   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8903   for (i=0;i<lsize;i++) vals[i] = 1.0;
8904   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8905   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8906   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8907   if (idxs) { /* multilevel guard */
8908     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8909     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8910   }
8911   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8912   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8913   ierr = PetscFree(vals);CHKERRQ(ierr);
8914   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8915   /* now compute set in local ordering */
8916   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8917   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8918   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8919   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8920   for (i=0,lsize=0;i<n;i++) {
8921     if (PetscRealPart(vals[i]) > 0.5) {
8922       lsize++;
8923     }
8924   }
8925   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8926   for (i=0,lsize=0;i<n;i++) {
8927     if (PetscRealPart(vals[i]) > 0.5) {
8928       idxs[lsize++] = i;
8929     }
8930   }
8931   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8932   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8933   *localis = localis_t;
8934   PetscFunctionReturn(0);
8935 }
8936 
8937 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8938 {
8939   PC_IS               *pcis=(PC_IS*)pc->data;
8940   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8941   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8942   Mat                 S_j;
8943   PetscInt            *used_xadj,*used_adjncy;
8944   PetscBool           free_used_adj;
8945   PetscErrorCode      ierr;
8946 
8947   PetscFunctionBegin;
8948   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8949   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8950   free_used_adj = PETSC_FALSE;
8951   if (pcbddc->sub_schurs_layers == -1) {
8952     used_xadj = NULL;
8953     used_adjncy = NULL;
8954   } else {
8955     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8956       used_xadj = pcbddc->mat_graph->xadj;
8957       used_adjncy = pcbddc->mat_graph->adjncy;
8958     } else if (pcbddc->computed_rowadj) {
8959       used_xadj = pcbddc->mat_graph->xadj;
8960       used_adjncy = pcbddc->mat_graph->adjncy;
8961     } else {
8962       PetscBool      flg_row=PETSC_FALSE;
8963       const PetscInt *xadj,*adjncy;
8964       PetscInt       nvtxs;
8965 
8966       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8967       if (flg_row) {
8968         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8969         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
8970         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
8971         free_used_adj = PETSC_TRUE;
8972       } else {
8973         pcbddc->sub_schurs_layers = -1;
8974         used_xadj = NULL;
8975         used_adjncy = NULL;
8976       }
8977       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8978     }
8979   }
8980 
8981   /* setup sub_schurs data */
8982   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8983   if (!sub_schurs->schur_explicit) {
8984     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8985     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8986     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);
8987   } else {
8988     Mat       change = NULL;
8989     Vec       scaling = NULL;
8990     IS        change_primal = NULL, iP;
8991     PetscInt  benign_n;
8992     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8993     PetscBool isseqaij,need_change = PETSC_FALSE;
8994     PetscBool discrete_harmonic = PETSC_FALSE;
8995 
8996     if (!pcbddc->use_vertices && reuse_solvers) {
8997       PetscInt n_vertices;
8998 
8999       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9000       reuse_solvers = (PetscBool)!n_vertices;
9001     }
9002     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
9003     if (!isseqaij) {
9004       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
9005       if (matis->A == pcbddc->local_mat) {
9006         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
9007         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9008       } else {
9009         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9010       }
9011     }
9012     if (!pcbddc->benign_change_explicit) {
9013       benign_n = pcbddc->benign_n;
9014     } else {
9015       benign_n = 0;
9016     }
9017     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9018        We need a global reduction to avoid possible deadlocks.
9019        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9020     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9021       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9022       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9023       need_change = (PetscBool)(!need_change);
9024     }
9025     /* If the user defines additional constraints, we import them here.
9026        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 */
9027     if (need_change) {
9028       PC_IS   *pcisf;
9029       PC_BDDC *pcbddcf;
9030       PC      pcf;
9031 
9032       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9033       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9034       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9035       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9036 
9037       /* hacks */
9038       pcisf                        = (PC_IS*)pcf->data;
9039       pcisf->is_B_local            = pcis->is_B_local;
9040       pcisf->vec1_N                = pcis->vec1_N;
9041       pcisf->BtoNmap               = pcis->BtoNmap;
9042       pcisf->n                     = pcis->n;
9043       pcisf->n_B                   = pcis->n_B;
9044       pcbddcf                      = (PC_BDDC*)pcf->data;
9045       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9046       pcbddcf->mat_graph           = pcbddc->mat_graph;
9047       pcbddcf->use_faces           = PETSC_TRUE;
9048       pcbddcf->use_change_of_basis = PETSC_TRUE;
9049       pcbddcf->use_change_on_faces = PETSC_TRUE;
9050       pcbddcf->use_qr_single       = PETSC_TRUE;
9051       pcbddcf->fake_change         = PETSC_TRUE;
9052 
9053       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9054       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9055       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9056       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9057       change = pcbddcf->ConstraintMatrix;
9058       pcbddcf->ConstraintMatrix = NULL;
9059 
9060       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9061       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9062       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9063       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9064       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9065       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9066       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9067       pcf->ops->destroy = NULL;
9068       pcf->ops->reset   = NULL;
9069       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9070     }
9071     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9072 
9073     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9074     if (iP) {
9075       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9076       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9077       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9078     }
9079     if (discrete_harmonic) {
9080       Mat A;
9081       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9082       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9083       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9084       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);
9085       ierr = MatDestroy(&A);CHKERRQ(ierr);
9086     } else {
9087       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);
9088     }
9089     ierr = MatDestroy(&change);CHKERRQ(ierr);
9090     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9091   }
9092   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9093 
9094   /* free adjacency */
9095   if (free_used_adj) {
9096     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9097   }
9098   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9099   PetscFunctionReturn(0);
9100 }
9101 
9102 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9103 {
9104   PC_IS               *pcis=(PC_IS*)pc->data;
9105   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9106   PCBDDCGraph         graph;
9107   PetscErrorCode      ierr;
9108 
9109   PetscFunctionBegin;
9110   /* attach interface graph for determining subsets */
9111   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9112     IS       verticesIS,verticescomm;
9113     PetscInt vsize,*idxs;
9114 
9115     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9116     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9117     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9118     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9119     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9120     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9121     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9122     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9123     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9124     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9125     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9126   } else {
9127     graph = pcbddc->mat_graph;
9128   }
9129   /* print some info */
9130   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9131     IS       vertices;
9132     PetscInt nv,nedges,nfaces;
9133     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9134     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9135     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9136     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9137     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9138     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9139     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9140     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9141     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9142     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9143     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9144   }
9145 
9146   /* sub_schurs init */
9147   if (!pcbddc->sub_schurs) {
9148     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9149   }
9150   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);
9151 
9152   /* free graph struct */
9153   if (pcbddc->sub_schurs_rebuild) {
9154     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9155   }
9156   PetscFunctionReturn(0);
9157 }
9158 
9159 PetscErrorCode PCBDDCCheckOperator(PC pc)
9160 {
9161   PC_IS               *pcis=(PC_IS*)pc->data;
9162   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9163   PetscErrorCode      ierr;
9164 
9165   PetscFunctionBegin;
9166   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9167     IS             zerodiag = NULL;
9168     Mat            S_j,B0_B=NULL;
9169     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9170     PetscScalar    *p0_check,*array,*array2;
9171     PetscReal      norm;
9172     PetscInt       i;
9173 
9174     /* B0 and B0_B */
9175     if (zerodiag) {
9176       IS       dummy;
9177 
9178       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9179       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9180       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9181       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9182     }
9183     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9184     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9185     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9186     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9187     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9188     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9189     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9190     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9191     /* S_j */
9192     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9193     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9194 
9195     /* mimic vector in \widetilde{W}_\Gamma */
9196     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9197     /* continuous in primal space */
9198     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9199     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9200     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9201     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9202     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9203     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9204     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9205     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9206     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9207     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9208     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9209     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9210     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9211     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9212 
9213     /* assemble rhs for coarse problem */
9214     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9215     /* local with Schur */
9216     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9217     if (zerodiag) {
9218       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9219       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9220       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9221       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9222     }
9223     /* sum on primal nodes the local contributions */
9224     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9225     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9226     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9227     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9228     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9229     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9230     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9231     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9232     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9233     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9234     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9235     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9236     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9237     /* scale primal nodes (BDDC sums contibutions) */
9238     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9239     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9240     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9241     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9242     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9243     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9244     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9245     /* global: \widetilde{B0}_B w_\Gamma */
9246     if (zerodiag) {
9247       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9248       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9249       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9250       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9251     }
9252     /* BDDC */
9253     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9254     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9255 
9256     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9257     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9258     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9259     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9260     for (i=0;i<pcbddc->benign_n;i++) {
9261       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);
9262     }
9263     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9264     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9265     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9266     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9267     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9268     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9269   }
9270   PetscFunctionReturn(0);
9271 }
9272 
9273 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9274 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9275 {
9276   Mat            At;
9277   IS             rows;
9278   PetscInt       rst,ren;
9279   PetscErrorCode ierr;
9280   PetscLayout    rmap;
9281 
9282   PetscFunctionBegin;
9283   rst = ren = 0;
9284   if (ccomm != MPI_COMM_NULL) {
9285     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9286     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9287     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9288     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9289     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9290   }
9291   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9292   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9293   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9294 
9295   if (ccomm != MPI_COMM_NULL) {
9296     Mat_MPIAIJ *a,*b;
9297     IS         from,to;
9298     Vec        gvec;
9299     PetscInt   lsize;
9300 
9301     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9302     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9303     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9304     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9305     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9306     a    = (Mat_MPIAIJ*)At->data;
9307     b    = (Mat_MPIAIJ*)(*B)->data;
9308     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9309     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9310     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9311     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9312     b->A = a->A;
9313     b->B = a->B;
9314 
9315     b->donotstash      = a->donotstash;
9316     b->roworiented     = a->roworiented;
9317     b->rowindices      = 0;
9318     b->rowvalues       = 0;
9319     b->getrowactive    = PETSC_FALSE;
9320 
9321     (*B)->rmap         = rmap;
9322     (*B)->factortype   = A->factortype;
9323     (*B)->assembled    = PETSC_TRUE;
9324     (*B)->insertmode   = NOT_SET_VALUES;
9325     (*B)->preallocated = PETSC_TRUE;
9326 
9327     if (a->colmap) {
9328 #if defined(PETSC_USE_CTABLE)
9329       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9330 #else
9331       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9332       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9333       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9334 #endif
9335     } else b->colmap = 0;
9336     if (a->garray) {
9337       PetscInt len;
9338       len  = a->B->cmap->n;
9339       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9340       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9341       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9342     } else b->garray = 0;
9343 
9344     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9345     b->lvec = a->lvec;
9346     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9347 
9348     /* cannot use VecScatterCopy */
9349     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9350     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9351     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9352     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9353     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9354     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9355     ierr = ISDestroy(&from);CHKERRQ(ierr);
9356     ierr = ISDestroy(&to);CHKERRQ(ierr);
9357     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9358   }
9359   ierr = MatDestroy(&At);CHKERRQ(ierr);
9360   PetscFunctionReturn(0);
9361 }
9362