xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 38cfc46e4752cf65941cec0be9bac4d1d6832cc8)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat               GEc;
121     const PetscScalar *vals;
122     PetscScalar       v;
123 
124     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
125     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
126     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
127     /* v    = PetscAbsScalar(vals[0]) */;
128     v    = 1.;
129     cvals[0] = vals[0]/v;
130     cvals[1] = vals[1]/v;
131     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
132     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
133 #if defined(PRINT_GDET)
134     {
135       PetscViewer viewer;
136       char filename[256];
137       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
138       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
139       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
141       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
142       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
143       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
144       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
145       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
146       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
147     }
148 #endif
149     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
150     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
151   }
152 
153   PetscFunctionReturn(0);
154 }
155 
156 PetscErrorCode PCBDDCNedelecSupport(PC pc)
157 {
158   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
159   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
160   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
161   Vec                    tvec;
162   PetscSF                sfv;
163   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
164   MPI_Comm               comm;
165   IS                     lned,primals,allprimals,nedfieldlocal;
166   IS                     *eedges,*extrows,*extcols,*alleedges;
167   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
168   PetscScalar            *vals,*work;
169   PetscReal              *rwork;
170   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
171   PetscInt               ne,nv,Lv,order,n,field;
172   PetscInt               n_neigh,*neigh,*n_shared,**shared;
173   PetscInt               i,j,extmem,cum,maxsize,nee;
174   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
175   PetscInt               *sfvleaves,*sfvroots;
176   PetscInt               *corners,*cedges;
177   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
178 #if defined(PETSC_USE_DEBUG)
179   PetscInt               *emarks;
180 #endif
181   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
182   PetscErrorCode         ierr;
183 
184   PetscFunctionBegin;
185   /* If the discrete gradient is defined for a subset of dofs and global is true,
186      it assumes G is given in global ordering for all the dofs.
187      Otherwise, the ordering is global for the Nedelec field */
188   order      = pcbddc->nedorder;
189   conforming = pcbddc->conforming;
190   field      = pcbddc->nedfield;
191   global     = pcbddc->nedglobal;
192   setprimal  = PETSC_FALSE;
193   print      = PETSC_FALSE;
194   singular   = PETSC_FALSE;
195 
196   /* Command line customization */
197   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
201   /* print debug info TODO: to be removed */
202   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
203   ierr = PetscOptionsEnd();CHKERRQ(ierr);
204 
205   /* Return if there are no edges in the decomposition and the problem is not singular */
206   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
207   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
208   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
209   if (!singular) {
210     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
211     lrc[0] = PETSC_FALSE;
212     for (i=0;i<n;i++) {
213       if (PetscRealPart(vals[i]) > 2.) {
214         lrc[0] = PETSC_TRUE;
215         break;
216       }
217     }
218     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
219     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
220     if (!lrc[1]) PetscFunctionReturn(0);
221   }
222 
223   /* Get Nedelec field */
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %D: number of fields is %D",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
237     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %D it's not a multiple of the order %D",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
324   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %D connected with nodal dof %D with order %D",test,i,ord);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
638   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
836       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %D: mark %D (ref mark %D), boundary %D\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %D and %D) connected through the %D nodal dof at edge dof %D",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1183     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       const PetscScalar *data;
1281       const PetscInt    *rows,*cols;
1282       PetscInt          nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %D and Gins %D does not match %D for coarse edge %D",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %D with ncc %D",i,ncc);
1297       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize,*gidxs;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1491   }
1492 
1493   /* compute local quad vec */
1494   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1495   if (!transpose) {
1496     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1497   } else {
1498     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1499   }
1500   ierr = VecSet(p,1.);CHKERRQ(ierr);
1501   if (!transpose) {
1502     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1503   } else {
1504     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1505   }
1506   if (vl2l) {
1507     Mat        lA;
1508     VecScatter sc;
1509 
1510     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1511     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1512     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1513     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1516   } else {
1517     vins = v;
1518   }
1519   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1520   ierr = VecDestroy(&p);CHKERRQ(ierr);
1521 
1522   /* insert in global quadrature vecs */
1523   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1524   for (i=0;i<n_neigh;i++) {
1525     const PetscInt    *idxs;
1526     PetscInt          idx,nn,j;
1527 
1528     idxs = shared[i];
1529     nn   = n_shared[i];
1530     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1531     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1532     idx  = -(idx+1);
1533     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1534     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614 
1615       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1616       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1617         PetscInt bs;
1618 
1619         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1620         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1621         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1622         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1623       }
1624       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1625       pcbddc->n_ISForDofs = 0;
1626       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1627     }
1628   } else {
1629     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1630       DM dm;
1631 
1632       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1633       if (!dm) {
1634         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1635       }
1636       if (dm) {
1637         IS      *fields;
1638         PetscInt nf,i;
1639 
1640         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1641         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1642         for (i=0;i<nf;i++) {
1643           PetscInt bs;
1644 
1645           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1646           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1647           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1648           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1649         }
1650         ierr = PetscFree(fields);CHKERRQ(ierr);
1651         pcbddc->n_ISForDofsLocal = nf;
1652       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1653         PetscContainer   c;
1654 
1655         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1656         if (c) {
1657           MatISLocalFields lf;
1658           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1659           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1660         } else { /* fallback, create the default fields if bs > 1 */
1661           PetscInt i, n = matis->A->rmap->n;
1662           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1663           if (i > 1) {
1664             pcbddc->n_ISForDofsLocal = i;
1665             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1666             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1667               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1668             }
1669           }
1670         }
1671       }
1672     } else {
1673       PetscInt i;
1674       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1675         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1676       }
1677     }
1678   }
1679 
1680 boundary:
1681   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1683   } else if (pcbddc->DirichletBoundariesLocal) {
1684     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1685   }
1686   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1687     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1688   } else if (pcbddc->NeumannBoundariesLocal) {
1689     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1690   }
1691   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1692     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1693   }
1694   ierr = VecDestroy(&global);CHKERRQ(ierr);
1695   ierr = VecDestroy(&local);CHKERRQ(ierr);
1696   /* detect local disconnected subdomains if requested (use matis->A) */
1697   if (pcbddc->detect_disconnected) {
1698     IS        primalv = NULL;
1699     PetscInt  i;
1700     PetscBool filter = pcbddc->detect_disconnected_filter;
1701 
1702     for (i=0;i<pcbddc->n_local_subs;i++) {
1703       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1704     }
1705     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1706     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1707     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1708     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1709   }
1710   /* early stage corner detection */
1711   {
1712     DM dm;
1713 
1714     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1715     if (!dm) {
1716       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1717     }
1718     if (dm) {
1719       PetscBool isda;
1720 
1721       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1722       if (isda) {
1723         ISLocalToGlobalMapping l2l;
1724         IS                     corners;
1725         Mat                    lA;
1726         PetscBool              gl,lo;
1727 
1728         {
1729           Vec               cvec;
1730           const PetscScalar *coords;
1731           PetscInt          dof,n,cdim;
1732           PetscBool         memc = PETSC_TRUE;
1733 
1734           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1735           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1736           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1737           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1738           n   /= cdim;
1739           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1740           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1741           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1742 #if defined(PETSC_USE_COMPLEX)
1743           memc = PETSC_FALSE;
1744 #endif
1745           if (dof != 1) memc = PETSC_FALSE;
1746           if (memc) {
1747             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1748           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1749             PetscReal *bcoords = pcbddc->mat_graph->coords;
1750             PetscInt  i, b, d;
1751 
1752             for (i=0;i<n;i++) {
1753               for (b=0;b<dof;b++) {
1754                 for (d=0;d<cdim;d++) {
1755                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1756                 }
1757               }
1758             }
1759           }
1760           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1761           pcbddc->mat_graph->cdim  = cdim;
1762           pcbddc->mat_graph->cnloc = dof*n;
1763           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1764         }
1765         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1766         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1767         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1768         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1769         lo   = (PetscBool)(l2l && corners);
1770         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1771         if (gl) { /* From PETSc's DMDA */
1772           const PetscInt    *idx;
1773           PetscInt          dof,bs,*idxout,n;
1774 
1775           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1776           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1777           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1778           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1779           if (bs == dof) {
1780             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1781             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1782           } else { /* the original DMDA local-to-local map have been modified */
1783             PetscInt i,d;
1784 
1785             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1786             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1787             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1788 
1789             bs = 1;
1790             n *= dof;
1791           }
1792           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1793           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1794           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1795           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1796           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1797           pcbddc->corner_selected  = PETSC_TRUE;
1798           pcbddc->corner_selection = PETSC_TRUE;
1799         }
1800         if (corners) {
1801           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1802         }
1803       }
1804     }
1805   }
1806   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1807     DM dm;
1808 
1809     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1810     if (!dm) {
1811       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1812     }
1813     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1814       Vec            vcoords;
1815       PetscSection   section;
1816       PetscReal      *coords;
1817       PetscInt       d,cdim,nl,nf,**ctxs;
1818       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1819 
1820       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1821       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1822       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1823       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1824       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1825       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1826       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1827       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1828       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1829       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1830       for (d=0;d<cdim;d++) {
1831         PetscInt          i;
1832         const PetscScalar *v;
1833 
1834         for (i=0;i<nf;i++) ctxs[i][0] = d;
1835         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1836         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1837         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1838         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1839       }
1840       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1841       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1842       ierr = PetscFree(coords);CHKERRQ(ierr);
1843       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1844       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1845     }
1846   }
1847   PetscFunctionReturn(0);
1848 }
1849 
1850 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1851 {
1852   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1853   PetscErrorCode  ierr;
1854   IS              nis;
1855   const PetscInt  *idxs;
1856   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1857   PetscBool       *ld;
1858 
1859   PetscFunctionBegin;
1860   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1861   if (mop == MPI_LAND) {
1862     /* init rootdata with true */
1863     ld   = (PetscBool*) matis->sf_rootdata;
1864     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1865   } else {
1866     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1867   }
1868   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1869   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1870   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1871   ld   = (PetscBool*) matis->sf_leafdata;
1872   for (i=0;i<nd;i++)
1873     if (-1 < idxs[i] && idxs[i] < n)
1874       ld[idxs[i]] = PETSC_TRUE;
1875   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1876   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1877   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1878   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1879   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1880   if (mop == MPI_LAND) {
1881     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1882   } else {
1883     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1884   }
1885   for (i=0,nnd=0;i<n;i++)
1886     if (ld[i])
1887       nidxs[nnd++] = i;
1888   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1889   ierr = ISDestroy(is);CHKERRQ(ierr);
1890   *is  = nis;
1891   PetscFunctionReturn(0);
1892 }
1893 
1894 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1895 {
1896   PC_IS             *pcis = (PC_IS*)(pc->data);
1897   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1898   PetscErrorCode    ierr;
1899 
1900   PetscFunctionBegin;
1901   if (!pcbddc->benign_have_null) {
1902     PetscFunctionReturn(0);
1903   }
1904   if (pcbddc->ChangeOfBasisMatrix) {
1905     Vec swap;
1906 
1907     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1908     swap = pcbddc->work_change;
1909     pcbddc->work_change = r;
1910     r = swap;
1911   }
1912   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1913   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1914   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1915   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1916   ierr = VecSet(z,0.);CHKERRQ(ierr);
1917   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1918   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1919   if (pcbddc->ChangeOfBasisMatrix) {
1920     pcbddc->work_change = r;
1921     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1922     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1923   }
1924   PetscFunctionReturn(0);
1925 }
1926 
1927 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1928 {
1929   PCBDDCBenignMatMult_ctx ctx;
1930   PetscErrorCode          ierr;
1931   PetscBool               apply_right,apply_left,reset_x;
1932 
1933   PetscFunctionBegin;
1934   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1935   if (transpose) {
1936     apply_right = ctx->apply_left;
1937     apply_left = ctx->apply_right;
1938   } else {
1939     apply_right = ctx->apply_right;
1940     apply_left = ctx->apply_left;
1941   }
1942   reset_x = PETSC_FALSE;
1943   if (apply_right) {
1944     const PetscScalar *ax;
1945     PetscInt          nl,i;
1946 
1947     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1948     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1949     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1950     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1951     for (i=0;i<ctx->benign_n;i++) {
1952       PetscScalar    sum,val;
1953       const PetscInt *idxs;
1954       PetscInt       nz,j;
1955       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1956       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1957       sum = 0.;
1958       if (ctx->apply_p0) {
1959         val = ctx->work[idxs[nz-1]];
1960         for (j=0;j<nz-1;j++) {
1961           sum += ctx->work[idxs[j]];
1962           ctx->work[idxs[j]] += val;
1963         }
1964       } else {
1965         for (j=0;j<nz-1;j++) {
1966           sum += ctx->work[idxs[j]];
1967         }
1968       }
1969       ctx->work[idxs[nz-1]] -= sum;
1970       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1971     }
1972     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1973     reset_x = PETSC_TRUE;
1974   }
1975   if (transpose) {
1976     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1977   } else {
1978     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1979   }
1980   if (reset_x) {
1981     ierr = VecResetArray(x);CHKERRQ(ierr);
1982   }
1983   if (apply_left) {
1984     PetscScalar *ay;
1985     PetscInt    i;
1986 
1987     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1988     for (i=0;i<ctx->benign_n;i++) {
1989       PetscScalar    sum,val;
1990       const PetscInt *idxs;
1991       PetscInt       nz,j;
1992       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1993       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1994       val = -ay[idxs[nz-1]];
1995       if (ctx->apply_p0) {
1996         sum = 0.;
1997         for (j=0;j<nz-1;j++) {
1998           sum += ay[idxs[j]];
1999           ay[idxs[j]] += val;
2000         }
2001         ay[idxs[nz-1]] += sum;
2002       } else {
2003         for (j=0;j<nz-1;j++) {
2004           ay[idxs[j]] += val;
2005         }
2006         ay[idxs[nz-1]] = 0.;
2007       }
2008       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2009     }
2010     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2011   }
2012   PetscFunctionReturn(0);
2013 }
2014 
2015 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2016 {
2017   PetscErrorCode ierr;
2018 
2019   PetscFunctionBegin;
2020   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2021   PetscFunctionReturn(0);
2022 }
2023 
2024 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2025 {
2026   PetscErrorCode ierr;
2027 
2028   PetscFunctionBegin;
2029   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2030   PetscFunctionReturn(0);
2031 }
2032 
2033 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2034 {
2035   PC_IS                   *pcis = (PC_IS*)pc->data;
2036   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2037   PCBDDCBenignMatMult_ctx ctx;
2038   PetscErrorCode          ierr;
2039 
2040   PetscFunctionBegin;
2041   if (!restore) {
2042     Mat                A_IB,A_BI;
2043     PetscScalar        *work;
2044     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2045 
2046     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2047     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2048     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2049     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2050     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2051     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2052     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2053     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2054     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2055     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2056     ctx->apply_left = PETSC_TRUE;
2057     ctx->apply_right = PETSC_FALSE;
2058     ctx->apply_p0 = PETSC_FALSE;
2059     ctx->benign_n = pcbddc->benign_n;
2060     if (reuse) {
2061       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2062       ctx->free = PETSC_FALSE;
2063     } else { /* TODO: could be optimized for successive solves */
2064       ISLocalToGlobalMapping N_to_D;
2065       PetscInt               i;
2066 
2067       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2068       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2069       for (i=0;i<pcbddc->benign_n;i++) {
2070         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2071       }
2072       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2073       ctx->free = PETSC_TRUE;
2074     }
2075     ctx->A = pcis->A_IB;
2076     ctx->work = work;
2077     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2078     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2079     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2080     pcis->A_IB = A_IB;
2081 
2082     /* A_BI as A_IB^T */
2083     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2084     pcbddc->benign_original_mat = pcis->A_BI;
2085     pcis->A_BI = A_BI;
2086   } else {
2087     if (!pcbddc->benign_original_mat) {
2088       PetscFunctionReturn(0);
2089     }
2090     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2091     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2092     pcis->A_IB = ctx->A;
2093     ctx->A = NULL;
2094     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2095     pcis->A_BI = pcbddc->benign_original_mat;
2096     pcbddc->benign_original_mat = NULL;
2097     if (ctx->free) {
2098       PetscInt i;
2099       for (i=0;i<ctx->benign_n;i++) {
2100         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2101       }
2102       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2103     }
2104     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2105     ierr = PetscFree(ctx);CHKERRQ(ierr);
2106   }
2107   PetscFunctionReturn(0);
2108 }
2109 
2110 /* used just in bddc debug mode */
2111 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2112 {
2113   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2114   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2115   Mat            An;
2116   PetscErrorCode ierr;
2117 
2118   PetscFunctionBegin;
2119   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2120   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2121   if (is1) {
2122     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2123     ierr = MatDestroy(&An);CHKERRQ(ierr);
2124   } else {
2125     *B = An;
2126   }
2127   PetscFunctionReturn(0);
2128 }
2129 
2130 /* TODO: add reuse flag */
2131 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2132 {
2133   Mat            Bt;
2134   PetscScalar    *a,*bdata;
2135   const PetscInt *ii,*ij;
2136   PetscInt       m,n,i,nnz,*bii,*bij;
2137   PetscBool      flg_row;
2138   PetscErrorCode ierr;
2139 
2140   PetscFunctionBegin;
2141   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2142   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2143   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2144   nnz = n;
2145   for (i=0;i<ii[n];i++) {
2146     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2147   }
2148   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2149   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2150   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2151   nnz = 0;
2152   bii[0] = 0;
2153   for (i=0;i<n;i++) {
2154     PetscInt j;
2155     for (j=ii[i];j<ii[i+1];j++) {
2156       PetscScalar entry = a[j];
2157       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2158         bij[nnz] = ij[j];
2159         bdata[nnz] = entry;
2160         nnz++;
2161       }
2162     }
2163     bii[i+1] = nnz;
2164   }
2165   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2166   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2167   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2168   {
2169     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2170     b->free_a = PETSC_TRUE;
2171     b->free_ij = PETSC_TRUE;
2172   }
2173   if (*B == A) {
2174     ierr = MatDestroy(&A);CHKERRQ(ierr);
2175   }
2176   *B = Bt;
2177   PetscFunctionReturn(0);
2178 }
2179 
2180 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2181 {
2182   Mat                    B = NULL;
2183   DM                     dm;
2184   IS                     is_dummy,*cc_n;
2185   ISLocalToGlobalMapping l2gmap_dummy;
2186   PCBDDCGraph            graph;
2187   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2188   PetscInt               i,n;
2189   PetscInt               *xadj,*adjncy;
2190   PetscBool              isplex = PETSC_FALSE;
2191   PetscErrorCode         ierr;
2192 
2193   PetscFunctionBegin;
2194   if (ncc) *ncc = 0;
2195   if (cc) *cc = NULL;
2196   if (primalv) *primalv = NULL;
2197   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2198   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2199   if (!dm) {
2200     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2201   }
2202   if (dm) {
2203     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2204   }
2205   if (filter) isplex = PETSC_FALSE;
2206 
2207   if (isplex) { /* this code has been modified from plexpartition.c */
2208     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2209     PetscInt      *adj = NULL;
2210     IS             cellNumbering;
2211     const PetscInt *cellNum;
2212     PetscBool      useCone, useClosure;
2213     PetscSection   section;
2214     PetscSegBuffer adjBuffer;
2215     PetscSF        sfPoint;
2216     PetscErrorCode ierr;
2217 
2218     PetscFunctionBegin;
2219     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2220     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2221     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2222     /* Build adjacency graph via a section/segbuffer */
2223     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2224     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2225     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2226     /* Always use FVM adjacency to create partitioner graph */
2227     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2228     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2229     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2230     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2231     for (n = 0, p = pStart; p < pEnd; p++) {
2232       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2233       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2234       adjSize = PETSC_DETERMINE;
2235       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2236       for (a = 0; a < adjSize; ++a) {
2237         const PetscInt point = adj[a];
2238         if (pStart <= point && point < pEnd) {
2239           PetscInt *PETSC_RESTRICT pBuf;
2240           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2241           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2242           *pBuf = point;
2243         }
2244       }
2245       n++;
2246     }
2247     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2248     /* Derive CSR graph from section/segbuffer */
2249     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2250     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2251     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2252     for (idx = 0, p = pStart; p < pEnd; p++) {
2253       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2254       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2255     }
2256     xadj[n] = size;
2257     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2258     /* Clean up */
2259     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2260     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2261     ierr = PetscFree(adj);CHKERRQ(ierr);
2262     graph->xadj = xadj;
2263     graph->adjncy = adjncy;
2264   } else {
2265     Mat       A;
2266     PetscBool isseqaij, flg_row;
2267 
2268     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2269     if (!A->rmap->N || !A->cmap->N) {
2270       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2271       PetscFunctionReturn(0);
2272     }
2273     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2274     if (!isseqaij && filter) {
2275       PetscBool isseqdense;
2276 
2277       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2278       if (!isseqdense) {
2279         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2280       } else { /* TODO: rectangular case and LDA */
2281         PetscScalar *array;
2282         PetscReal   chop=1.e-6;
2283 
2284         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2285         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2286         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2287         for (i=0;i<n;i++) {
2288           PetscInt j;
2289           for (j=i+1;j<n;j++) {
2290             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2291             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2292             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2293           }
2294         }
2295         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2296         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2297       }
2298     } else {
2299       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2300       B = A;
2301     }
2302     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2303 
2304     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2305     if (filter) {
2306       PetscScalar *data;
2307       PetscInt    j,cum;
2308 
2309       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2310       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2311       cum = 0;
2312       for (i=0;i<n;i++) {
2313         PetscInt t;
2314 
2315         for (j=xadj[i];j<xadj[i+1];j++) {
2316           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2317             continue;
2318           }
2319           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2320         }
2321         t = xadj_filtered[i];
2322         xadj_filtered[i] = cum;
2323         cum += t;
2324       }
2325       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2326       graph->xadj = xadj_filtered;
2327       graph->adjncy = adjncy_filtered;
2328     } else {
2329       graph->xadj = xadj;
2330       graph->adjncy = adjncy;
2331     }
2332   }
2333   /* compute local connected components using PCBDDCGraph */
2334   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2335   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2336   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2337   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2338   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2339   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2340   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2341 
2342   /* partial clean up */
2343   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2344   if (B) {
2345     PetscBool flg_row;
2346     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2347     ierr = MatDestroy(&B);CHKERRQ(ierr);
2348   }
2349   if (isplex) {
2350     ierr = PetscFree(xadj);CHKERRQ(ierr);
2351     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2352   }
2353 
2354   /* get back data */
2355   if (isplex) {
2356     if (ncc) *ncc = graph->ncc;
2357     if (cc || primalv) {
2358       Mat          A;
2359       PetscBT      btv,btvt;
2360       PetscSection subSection;
2361       PetscInt     *ids,cum,cump,*cids,*pids;
2362 
2363       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2364       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2365       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2366       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2367       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2368 
2369       cids[0] = 0;
2370       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2371         PetscInt j;
2372 
2373         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2374         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2375           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2376 
2377           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2378           for (k = 0; k < 2*size; k += 2) {
2379             PetscInt s, pp, p = closure[k], off, dof, cdof;
2380 
2381             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2382             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2383             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2384             for (s = 0; s < dof-cdof; s++) {
2385               if (PetscBTLookupSet(btvt,off+s)) continue;
2386               if (!PetscBTLookup(btv,off+s)) {
2387                 ids[cum++] = off+s;
2388               } else { /* cross-vertex */
2389                 pids[cump++] = off+s;
2390               }
2391             }
2392             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2393             if (pp != p) {
2394               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2395               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2396               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2397               for (s = 0; s < dof-cdof; s++) {
2398                 if (PetscBTLookupSet(btvt,off+s)) continue;
2399                 if (!PetscBTLookup(btv,off+s)) {
2400                   ids[cum++] = off+s;
2401                 } else { /* cross-vertex */
2402                   pids[cump++] = off+s;
2403                 }
2404               }
2405             }
2406           }
2407           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2408         }
2409         cids[i+1] = cum;
2410         /* mark dofs as already assigned */
2411         for (j = cids[i]; j < cids[i+1]; j++) {
2412           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2413         }
2414       }
2415       if (cc) {
2416         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2417         for (i = 0; i < graph->ncc; i++) {
2418           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2419         }
2420         *cc = cc_n;
2421       }
2422       if (primalv) {
2423         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2424       }
2425       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2426       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2427       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2428     }
2429   } else {
2430     if (ncc) *ncc = graph->ncc;
2431     if (cc) {
2432       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2433       for (i=0;i<graph->ncc;i++) {
2434         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2435       }
2436       *cc = cc_n;
2437     }
2438   }
2439   /* clean up graph */
2440   graph->xadj = 0;
2441   graph->adjncy = 0;
2442   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2443   PetscFunctionReturn(0);
2444 }
2445 
2446 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2447 {
2448   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2449   PC_IS*         pcis = (PC_IS*)(pc->data);
2450   IS             dirIS = NULL;
2451   PetscInt       i;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2456   if (zerodiag) {
2457     Mat            A;
2458     Vec            vec3_N;
2459     PetscScalar    *vals;
2460     const PetscInt *idxs;
2461     PetscInt       nz,*count;
2462 
2463     /* p0 */
2464     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2465     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2466     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2467     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2468     for (i=0;i<nz;i++) vals[i] = 1.;
2469     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2470     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2471     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2472     /* v_I */
2473     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2474     for (i=0;i<nz;i++) vals[i] = 0.;
2475     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2476     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2477     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2478     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2479     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2480     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2481     if (dirIS) {
2482       PetscInt n;
2483 
2484       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2485       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2486       for (i=0;i<n;i++) vals[i] = 0.;
2487       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2488       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2489     }
2490     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2491     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2492     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2493     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2494     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2495     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2496     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2497     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2498     ierr = PetscFree(vals);CHKERRQ(ierr);
2499     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2500 
2501     /* there should not be any pressure dofs lying on the interface */
2502     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2503     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2504     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2505     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2506     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2507     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %D is an interface dof",idxs[i]);
2508     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2509     ierr = PetscFree(count);CHKERRQ(ierr);
2510   }
2511   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2512 
2513   /* check PCBDDCBenignGetOrSetP0 */
2514   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2515   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2516   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2517   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2518   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2519   for (i=0;i<pcbddc->benign_n;i++) {
2520     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2521     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2522   }
2523   PetscFunctionReturn(0);
2524 }
2525 
2526 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2527 {
2528   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2529   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2530   PetscInt       nz,n,benign_n,bsp = 1;
2531   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2532   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2533   PetscErrorCode ierr;
2534 
2535   PetscFunctionBegin;
2536   if (reuse) goto project_b0;
2537   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2538   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2539   for (n=0;n<pcbddc->benign_n;n++) {
2540     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2541   }
2542   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2543   has_null_pressures = PETSC_TRUE;
2544   have_null = PETSC_TRUE;
2545   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2546      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2547      Checks if all the pressure dofs in each subdomain have a zero diagonal
2548      If not, a change of basis on pressures is not needed
2549      since the local Schur complements are already SPD
2550   */
2551   if (pcbddc->n_ISForDofsLocal) {
2552     IS        iP = NULL;
2553     PetscInt  p,*pp;
2554     PetscBool flg;
2555 
2556     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2557     n    = pcbddc->n_ISForDofsLocal;
2558     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2559     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2560     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2561     if (!flg) {
2562       n = 1;
2563       pp[0] = pcbddc->n_ISForDofsLocal-1;
2564     }
2565 
2566     bsp = 0;
2567     for (p=0;p<n;p++) {
2568       PetscInt bs;
2569 
2570       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2571       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2572       bsp += bs;
2573     }
2574     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2575     bsp  = 0;
2576     for (p=0;p<n;p++) {
2577       const PetscInt *idxs;
2578       PetscInt       b,bs,npl,*bidxs;
2579 
2580       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2581       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2582       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2583       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2584       for (b=0;b<bs;b++) {
2585         PetscInt i;
2586 
2587         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2588         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2589         bsp++;
2590       }
2591       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2592       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2593     }
2594     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2595 
2596     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2597     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2598     if (iP) {
2599       IS newpressures;
2600 
2601       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2602       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2603       pressures = newpressures;
2604     }
2605     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2606     if (!sorted) {
2607       ierr = ISSort(pressures);CHKERRQ(ierr);
2608     }
2609     ierr = PetscFree(pp);CHKERRQ(ierr);
2610   }
2611 
2612   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2613   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2614   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2615   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2616   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2617   if (!sorted) {
2618     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2619   }
2620   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2621   zerodiag_save = zerodiag;
2622   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2623   if (!nz) {
2624     if (n) have_null = PETSC_FALSE;
2625     has_null_pressures = PETSC_FALSE;
2626     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2627   }
2628   recompute_zerodiag = PETSC_FALSE;
2629 
2630   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2631   zerodiag_subs    = NULL;
2632   benign_n         = 0;
2633   n_interior_dofs  = 0;
2634   interior_dofs    = NULL;
2635   nneu             = 0;
2636   if (pcbddc->NeumannBoundariesLocal) {
2637     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2638   }
2639   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2640   if (checkb) { /* need to compute interior nodes */
2641     PetscInt n,i,j;
2642     PetscInt n_neigh,*neigh,*n_shared,**shared;
2643     PetscInt *iwork;
2644 
2645     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2646     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2647     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2648     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2649     for (i=1;i<n_neigh;i++)
2650       for (j=0;j<n_shared[i];j++)
2651           iwork[shared[i][j]] += 1;
2652     for (i=0;i<n;i++)
2653       if (!iwork[i])
2654         interior_dofs[n_interior_dofs++] = i;
2655     ierr = PetscFree(iwork);CHKERRQ(ierr);
2656     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2657   }
2658   if (has_null_pressures) {
2659     IS             *subs;
2660     PetscInt       nsubs,i,j,nl;
2661     const PetscInt *idxs;
2662     PetscScalar    *array;
2663     Vec            *work;
2664     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2665 
2666     subs  = pcbddc->local_subs;
2667     nsubs = pcbddc->n_local_subs;
2668     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2669     if (checkb) {
2670       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2671       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2672       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2673       /* work[0] = 1_p */
2674       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2675       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2676       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2677       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2678       /* work[0] = 1_v */
2679       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2680       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2681       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2682       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2683       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2684     }
2685 
2686     if (nsubs > 1 || bsp > 1) {
2687       IS       *is;
2688       PetscInt b,totb;
2689 
2690       totb  = bsp;
2691       is    = bsp > 1 ? bzerodiag : &zerodiag;
2692       nsubs = PetscMax(nsubs,1);
2693       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2694       for (b=0;b<totb;b++) {
2695         for (i=0;i<nsubs;i++) {
2696           ISLocalToGlobalMapping l2g;
2697           IS                     t_zerodiag_subs;
2698           PetscInt               nl;
2699 
2700           if (subs) {
2701             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2702           } else {
2703             IS tis;
2704 
2705             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2706             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2707             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2708             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2709           }
2710           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2711           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2712           if (nl) {
2713             PetscBool valid = PETSC_TRUE;
2714 
2715             if (checkb) {
2716               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2717               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2718               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2719               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2720               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2721               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2722               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2723               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2724               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2725               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2726               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2727               for (j=0;j<n_interior_dofs;j++) {
2728                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2729                   valid = PETSC_FALSE;
2730                   break;
2731                 }
2732               }
2733               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2734             }
2735             if (valid && nneu) {
2736               const PetscInt *idxs;
2737               PetscInt       nzb;
2738 
2739               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2740               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2741               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2742               if (nzb) valid = PETSC_FALSE;
2743             }
2744             if (valid && pressures) {
2745               IS       t_pressure_subs,tmp;
2746               PetscInt i1,i2;
2747 
2748               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2749               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2750               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2751               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2752               if (i2 != i1) valid = PETSC_FALSE;
2753               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2754               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2755             }
2756             if (valid) {
2757               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2758               benign_n++;
2759             } else recompute_zerodiag = PETSC_TRUE;
2760           }
2761           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2762           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2763         }
2764       }
2765     } else { /* there's just one subdomain (or zero if they have not been detected */
2766       PetscBool valid = PETSC_TRUE;
2767 
2768       if (nneu) valid = PETSC_FALSE;
2769       if (valid && pressures) {
2770         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2771       }
2772       if (valid && checkb) {
2773         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2774         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2775         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2776         for (j=0;j<n_interior_dofs;j++) {
2777           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2778             valid = PETSC_FALSE;
2779             break;
2780           }
2781         }
2782         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2783       }
2784       if (valid) {
2785         benign_n = 1;
2786         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2787         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2788         zerodiag_subs[0] = zerodiag;
2789       }
2790     }
2791     if (checkb) {
2792       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2793     }
2794   }
2795   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2796 
2797   if (!benign_n) {
2798     PetscInt n;
2799 
2800     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2801     recompute_zerodiag = PETSC_FALSE;
2802     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2803     if (n) have_null = PETSC_FALSE;
2804   }
2805 
2806   /* final check for null pressures */
2807   if (zerodiag && pressures) {
2808     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2809   }
2810 
2811   if (recompute_zerodiag) {
2812     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2813     if (benign_n == 1) {
2814       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2815       zerodiag = zerodiag_subs[0];
2816     } else {
2817       PetscInt i,nzn,*new_idxs;
2818 
2819       nzn = 0;
2820       for (i=0;i<benign_n;i++) {
2821         PetscInt ns;
2822         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2823         nzn += ns;
2824       }
2825       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2826       nzn = 0;
2827       for (i=0;i<benign_n;i++) {
2828         PetscInt ns,*idxs;
2829         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2830         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2831         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2832         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2833         nzn += ns;
2834       }
2835       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2836       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2837     }
2838     have_null = PETSC_FALSE;
2839   }
2840 
2841   /* determines if the coarse solver will be singular or not */
2842   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2843 
2844   /* Prepare matrix to compute no-net-flux */
2845   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2846     Mat                    A,loc_divudotp;
2847     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2848     IS                     row,col,isused = NULL;
2849     PetscInt               M,N,n,st,n_isused;
2850 
2851     if (pressures) {
2852       isused = pressures;
2853     } else {
2854       isused = zerodiag_save;
2855     }
2856     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2857     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2858     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2859     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2860     n_isused = 0;
2861     if (isused) {
2862       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2863     }
2864     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2865     st = st-n_isused;
2866     if (n) {
2867       const PetscInt *gidxs;
2868 
2869       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2870       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2871       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2872       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2873       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2874       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2875     } else {
2876       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2877       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2878       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2879     }
2880     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2881     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2882     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2883     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2884     ierr = ISDestroy(&row);CHKERRQ(ierr);
2885     ierr = ISDestroy(&col);CHKERRQ(ierr);
2886     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2887     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2888     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2889     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2890     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2891     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2892     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2893     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2894     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2895     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2896   }
2897   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2898   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2899   if (bzerodiag) {
2900     PetscInt i;
2901 
2902     for (i=0;i<bsp;i++) {
2903       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2904     }
2905     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2906   }
2907   pcbddc->benign_n = benign_n;
2908   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2909 
2910   /* determines if the problem has subdomains with 0 pressure block */
2911   have_null = (PetscBool)(!!pcbddc->benign_n);
2912   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2913 
2914 project_b0:
2915   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2916   /* change of basis and p0 dofs */
2917   if (pcbddc->benign_n) {
2918     PetscInt i,s,*nnz;
2919 
2920     /* local change of basis for pressures */
2921     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2922     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2923     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2924     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2925     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2926     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2927     for (i=0;i<pcbddc->benign_n;i++) {
2928       const PetscInt *idxs;
2929       PetscInt       nzs,j;
2930 
2931       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2932       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2933       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2934       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2935       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2936     }
2937     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2938     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2939     ierr = PetscFree(nnz);CHKERRQ(ierr);
2940     /* set identity by default */
2941     for (i=0;i<n;i++) {
2942       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2943     }
2944     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2945     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2946     /* set change on pressures */
2947     for (s=0;s<pcbddc->benign_n;s++) {
2948       PetscScalar    *array;
2949       const PetscInt *idxs;
2950       PetscInt       nzs;
2951 
2952       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2953       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2954       for (i=0;i<nzs-1;i++) {
2955         PetscScalar vals[2];
2956         PetscInt    cols[2];
2957 
2958         cols[0] = idxs[i];
2959         cols[1] = idxs[nzs-1];
2960         vals[0] = 1.;
2961         vals[1] = 1.;
2962         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2963       }
2964       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2965       for (i=0;i<nzs-1;i++) array[i] = -1.;
2966       array[nzs-1] = 1.;
2967       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2968       /* store local idxs for p0 */
2969       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2970       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2971       ierr = PetscFree(array);CHKERRQ(ierr);
2972     }
2973     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2974     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975 
2976     /* project if needed */
2977     if (pcbddc->benign_change_explicit) {
2978       Mat M;
2979 
2980       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2981       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2982       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2983       ierr = MatDestroy(&M);CHKERRQ(ierr);
2984     }
2985     /* store global idxs for p0 */
2986     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2987   }
2988   *zerodiaglocal = zerodiag;
2989   PetscFunctionReturn(0);
2990 }
2991 
2992 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2993 {
2994   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2995   PetscScalar    *array;
2996   PetscErrorCode ierr;
2997 
2998   PetscFunctionBegin;
2999   if (!pcbddc->benign_sf) {
3000     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3001     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3002   }
3003   if (get) {
3004     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3005     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3006     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3007     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3008   } else {
3009     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3010     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3011     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3012     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3013   }
3014   PetscFunctionReturn(0);
3015 }
3016 
3017 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3018 {
3019   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3020   PetscErrorCode ierr;
3021 
3022   PetscFunctionBegin;
3023   /* TODO: add error checking
3024     - avoid nested pop (or push) calls.
3025     - cannot push before pop.
3026     - cannot call this if pcbddc->local_mat is NULL
3027   */
3028   if (!pcbddc->benign_n) {
3029     PetscFunctionReturn(0);
3030   }
3031   if (pop) {
3032     if (pcbddc->benign_change_explicit) {
3033       IS       is_p0;
3034       MatReuse reuse;
3035 
3036       /* extract B_0 */
3037       reuse = MAT_INITIAL_MATRIX;
3038       if (pcbddc->benign_B0) {
3039         reuse = MAT_REUSE_MATRIX;
3040       }
3041       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3042       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3043       /* remove rows and cols from local problem */
3044       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3045       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3046       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3047       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3048     } else {
3049       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3050       PetscScalar *vals;
3051       PetscInt    i,n,*idxs_ins;
3052 
3053       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3054       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3055       if (!pcbddc->benign_B0) {
3056         PetscInt *nnz;
3057         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3058         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3059         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3060         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3061         for (i=0;i<pcbddc->benign_n;i++) {
3062           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3063           nnz[i] = n - nnz[i];
3064         }
3065         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3066         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3067         ierr = PetscFree(nnz);CHKERRQ(ierr);
3068       }
3069 
3070       for (i=0;i<pcbddc->benign_n;i++) {
3071         PetscScalar *array;
3072         PetscInt    *idxs,j,nz,cum;
3073 
3074         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3075         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3076         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3077         for (j=0;j<nz;j++) vals[j] = 1.;
3078         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3079         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3080         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3081         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3082         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3083         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3084         cum = 0;
3085         for (j=0;j<n;j++) {
3086           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3087             vals[cum] = array[j];
3088             idxs_ins[cum] = j;
3089             cum++;
3090           }
3091         }
3092         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3093         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3094         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3095       }
3096       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3097       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3098       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3099     }
3100   } else { /* push */
3101     if (pcbddc->benign_change_explicit) {
3102       PetscInt i;
3103 
3104       for (i=0;i<pcbddc->benign_n;i++) {
3105         PetscScalar *B0_vals;
3106         PetscInt    *B0_cols,B0_ncol;
3107 
3108         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3109         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3110         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3111         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3112         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3113       }
3114       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3115       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3116     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3117   }
3118   PetscFunctionReturn(0);
3119 }
3120 
3121 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3122 {
3123   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3124   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3125   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3126   PetscBLASInt    *B_iwork,*B_ifail;
3127   PetscScalar     *work,lwork;
3128   PetscScalar     *St,*S,*eigv;
3129   PetscScalar     *Sarray,*Starray;
3130   PetscReal       *eigs,thresh,lthresh,uthresh;
3131   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3132   PetscBool       allocated_S_St;
3133 #if defined(PETSC_USE_COMPLEX)
3134   PetscReal       *rwork;
3135 #endif
3136   PetscErrorCode  ierr;
3137 
3138   PetscFunctionBegin;
3139   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3140   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3141   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3142   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3143 
3144   if (pcbddc->dbg_flag) {
3145     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3146     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3147     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3148     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3149   }
3150 
3151   if (pcbddc->dbg_flag) {
3152     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3153   }
3154 
3155   /* max size of subsets */
3156   mss = 0;
3157   for (i=0;i<sub_schurs->n_subs;i++) {
3158     PetscInt subset_size;
3159 
3160     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3161     mss = PetscMax(mss,subset_size);
3162   }
3163 
3164   /* min/max and threshold */
3165   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3166   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3167   nmax = PetscMax(nmin,nmax);
3168   allocated_S_St = PETSC_FALSE;
3169   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3170     allocated_S_St = PETSC_TRUE;
3171   }
3172 
3173   /* allocate lapack workspace */
3174   cum = cum2 = 0;
3175   maxneigs = 0;
3176   for (i=0;i<sub_schurs->n_subs;i++) {
3177     PetscInt n,subset_size;
3178 
3179     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3180     n = PetscMin(subset_size,nmax);
3181     cum += subset_size;
3182     cum2 += subset_size*n;
3183     maxneigs = PetscMax(maxneigs,n);
3184   }
3185   if (mss) {
3186     if (sub_schurs->is_symmetric) {
3187       PetscBLASInt B_itype = 1;
3188       PetscBLASInt B_N = mss;
3189       PetscReal    zero = 0.0;
3190       PetscReal    eps = 0.0; /* dlamch? */
3191 
3192       B_lwork = -1;
3193       S = NULL;
3194       St = NULL;
3195       eigs = NULL;
3196       eigv = NULL;
3197       B_iwork = NULL;
3198       B_ifail = NULL;
3199 #if defined(PETSC_USE_COMPLEX)
3200       rwork = NULL;
3201 #endif
3202       thresh = 1.0;
3203       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3204 #if defined(PETSC_USE_COMPLEX)
3205       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3206 #else
3207       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3208 #endif
3209       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3210       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3211     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3212   } else {
3213     lwork = 0;
3214   }
3215 
3216   nv = 0;
3217   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3218     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3219   }
3220   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3221   if (allocated_S_St) {
3222     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3223   }
3224   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3225 #if defined(PETSC_USE_COMPLEX)
3226   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3227 #endif
3228   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3229                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3230                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3231                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3232                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3233   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3234 
3235   maxneigs = 0;
3236   cum = cumarray = 0;
3237   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3238   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3239   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3240     const PetscInt *idxs;
3241 
3242     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3243     for (cum=0;cum<nv;cum++) {
3244       pcbddc->adaptive_constraints_n[cum] = 1;
3245       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3246       pcbddc->adaptive_constraints_data[cum] = 1.0;
3247       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3248       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3249     }
3250     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3251   }
3252 
3253   if (mss) { /* multilevel */
3254     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3255     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3256   }
3257 
3258   lthresh = pcbddc->adaptive_threshold[0];
3259   uthresh = pcbddc->adaptive_threshold[1];
3260   for (i=0;i<sub_schurs->n_subs;i++) {
3261     const PetscInt *idxs;
3262     PetscReal      upper,lower;
3263     PetscInt       j,subset_size,eigs_start = 0;
3264     PetscBLASInt   B_N;
3265     PetscBool      same_data = PETSC_FALSE;
3266     PetscBool      scal = PETSC_FALSE;
3267 
3268     if (pcbddc->use_deluxe_scaling) {
3269       upper = PETSC_MAX_REAL;
3270       lower = uthresh;
3271     } else {
3272       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3273       upper = 1./uthresh;
3274       lower = 0.;
3275     }
3276     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3277     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3278     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3279     /* this is experimental: we assume the dofs have been properly grouped to have
3280        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3281     if (!sub_schurs->is_posdef) {
3282       Mat T;
3283 
3284       for (j=0;j<subset_size;j++) {
3285         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3286           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3287           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3288           ierr = MatDestroy(&T);CHKERRQ(ierr);
3289           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3290           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3291           ierr = MatDestroy(&T);CHKERRQ(ierr);
3292           if (sub_schurs->change_primal_sub) {
3293             PetscInt       nz,k;
3294             const PetscInt *idxs;
3295 
3296             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3297             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3298             for (k=0;k<nz;k++) {
3299               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3300               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3301             }
3302             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3303           }
3304           scal = PETSC_TRUE;
3305           break;
3306         }
3307       }
3308     }
3309 
3310     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3311       if (sub_schurs->is_symmetric) {
3312         PetscInt j,k;
3313         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3314           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3315           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3316         }
3317         for (j=0;j<subset_size;j++) {
3318           for (k=j;k<subset_size;k++) {
3319             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3320             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3321           }
3322         }
3323       } else {
3324         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3325         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3326       }
3327     } else {
3328       S = Sarray + cumarray;
3329       St = Starray + cumarray;
3330     }
3331     /* see if we can save some work */
3332     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3333       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3334     }
3335 
3336     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3337       B_neigs = 0;
3338     } else {
3339       if (sub_schurs->is_symmetric) {
3340         PetscBLASInt B_itype = 1;
3341         PetscBLASInt B_IL, B_IU;
3342         PetscReal    eps = -1.0; /* dlamch? */
3343         PetscInt     nmin_s;
3344         PetscBool    compute_range;
3345 
3346         B_neigs = 0;
3347         compute_range = (PetscBool)!same_data;
3348         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3349 
3350         if (pcbddc->dbg_flag) {
3351           PetscInt nc = 0;
3352 
3353           if (sub_schurs->change_primal_sub) {
3354             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3355           }
3356           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3357         }
3358 
3359         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3360         if (compute_range) {
3361 
3362           /* ask for eigenvalues larger than thresh */
3363           if (sub_schurs->is_posdef) {
3364 #if defined(PETSC_USE_COMPLEX)
3365             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3366 #else
3367             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3368 #endif
3369             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3370           } else { /* no theory so far, but it works nicely */
3371             PetscInt  recipe = 0,recipe_m = 1;
3372             PetscReal bb[2];
3373 
3374             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3375             switch (recipe) {
3376             case 0:
3377               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3378               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3379 #if defined(PETSC_USE_COMPLEX)
3380               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3381 #else
3382               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3383 #endif
3384               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3385               break;
3386             case 1:
3387               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3388 #if defined(PETSC_USE_COMPLEX)
3389               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3390 #else
3391               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3392 #endif
3393               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3394               if (!scal) {
3395                 PetscBLASInt B_neigs2 = 0;
3396 
3397                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3398                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3399                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3400 #if defined(PETSC_USE_COMPLEX)
3401                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3402 #else
3403                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3404 #endif
3405                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3406                 B_neigs += B_neigs2;
3407               }
3408               break;
3409             case 2:
3410               if (scal) {
3411                 bb[0] = PETSC_MIN_REAL;
3412                 bb[1] = 0;
3413 #if defined(PETSC_USE_COMPLEX)
3414                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3415 #else
3416                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3417 #endif
3418                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3419               } else {
3420                 PetscBLASInt B_neigs2 = 0;
3421                 PetscBool    import = PETSC_FALSE;
3422 
3423                 lthresh = PetscMax(lthresh,0.0);
3424                 if (lthresh > 0.0) {
3425                   bb[0] = PETSC_MIN_REAL;
3426                   bb[1] = lthresh*lthresh;
3427 
3428                   import = PETSC_TRUE;
3429 #if defined(PETSC_USE_COMPLEX)
3430                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3431 #else
3432                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3433 #endif
3434                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3435                 }
3436                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3437                 bb[1] = PETSC_MAX_REAL;
3438                 if (import) {
3439                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3440                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3441                 }
3442 #if defined(PETSC_USE_COMPLEX)
3443                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3444 #else
3445                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3446 #endif
3447                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3448                 B_neigs += B_neigs2;
3449               }
3450               break;
3451             case 3:
3452               if (scal) {
3453                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3454               } else {
3455                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3456               }
3457               if (!scal) {
3458                 bb[0] = uthresh;
3459                 bb[1] = PETSC_MAX_REAL;
3460 #if defined(PETSC_USE_COMPLEX)
3461                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3462 #else
3463                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3464 #endif
3465                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3466               }
3467               if (recipe_m > 0 && B_N - B_neigs > 0) {
3468                 PetscBLASInt B_neigs2 = 0;
3469 
3470                 B_IL = 1;
3471                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3472                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3473                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3474 #if defined(PETSC_USE_COMPLEX)
3475                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3476 #else
3477                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3478 #endif
3479                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3480                 B_neigs += B_neigs2;
3481               }
3482               break;
3483             case 4:
3484               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3485 #if defined(PETSC_USE_COMPLEX)
3486               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3487 #else
3488               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3489 #endif
3490               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3491               {
3492                 PetscBLASInt B_neigs2 = 0;
3493 
3494                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3495                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3496                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3497 #if defined(PETSC_USE_COMPLEX)
3498                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3499 #else
3500                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3501 #endif
3502                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3503                 B_neigs += B_neigs2;
3504               }
3505               break;
3506             case 5: /* same as before: first compute all eigenvalues, then filter */
3507 #if defined(PETSC_USE_COMPLEX)
3508               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3509 #else
3510               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3511 #endif
3512               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3513               {
3514                 PetscInt e,k,ne;
3515                 for (e=0,ne=0;e<B_neigs;e++) {
3516                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3517                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3518                     eigs[ne] = eigs[e];
3519                     ne++;
3520                   }
3521                 }
3522                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3523                 B_neigs = ne;
3524               }
3525               break;
3526             default:
3527               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3528               break;
3529             }
3530           }
3531         } else if (!same_data) { /* this is just to see all the eigenvalues */
3532           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3533           B_IL = 1;
3534 #if defined(PETSC_USE_COMPLEX)
3535           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3536 #else
3537           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3538 #endif
3539           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3540         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3541           PetscInt k;
3542           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3543           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3544           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3545           nmin = nmax;
3546           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3547           for (k=0;k<nmax;k++) {
3548             eigs[k] = 1./PETSC_SMALL;
3549             eigv[k*(subset_size+1)] = 1.0;
3550           }
3551         }
3552         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3553         if (B_ierr) {
3554           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3555           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3556           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3557         }
3558 
3559         if (B_neigs > nmax) {
3560           if (pcbddc->dbg_flag) {
3561             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3562           }
3563           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3564           B_neigs = nmax;
3565         }
3566 
3567         nmin_s = PetscMin(nmin,B_N);
3568         if (B_neigs < nmin_s) {
3569           PetscBLASInt B_neigs2 = 0;
3570 
3571           if (pcbddc->use_deluxe_scaling) {
3572             if (scal) {
3573               B_IU = nmin_s;
3574               B_IL = B_neigs + 1;
3575             } else {
3576               B_IL = B_N - nmin_s + 1;
3577               B_IU = B_N - B_neigs;
3578             }
3579           } else {
3580             B_IL = B_neigs + 1;
3581             B_IU = nmin_s;
3582           }
3583           if (pcbddc->dbg_flag) {
3584             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %D. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);CHKERRQ(ierr);
3585           }
3586           if (sub_schurs->is_symmetric) {
3587             PetscInt j,k;
3588             for (j=0;j<subset_size;j++) {
3589               for (k=j;k<subset_size;k++) {
3590                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3591                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3592               }
3593             }
3594           } else {
3595             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3596             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3597           }
3598           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3599 #if defined(PETSC_USE_COMPLEX)
3600           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3601 #else
3602           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3603 #endif
3604           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3605           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3606           B_neigs += B_neigs2;
3607         }
3608         if (B_ierr) {
3609           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3610           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3611           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3612         }
3613         if (pcbddc->dbg_flag) {
3614           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3615           for (j=0;j<B_neigs;j++) {
3616             if (eigs[j] == 0.0) {
3617               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3618             } else {
3619               if (pcbddc->use_deluxe_scaling) {
3620                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3621               } else {
3622                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3623               }
3624             }
3625           }
3626         }
3627       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3628     }
3629     /* change the basis back to the original one */
3630     if (sub_schurs->change) {
3631       Mat change,phi,phit;
3632 
3633       if (pcbddc->dbg_flag > 2) {
3634         PetscInt ii;
3635         for (ii=0;ii<B_neigs;ii++) {
3636           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3637           for (j=0;j<B_N;j++) {
3638 #if defined(PETSC_USE_COMPLEX)
3639             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3640             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3641             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3642 #else
3643             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3644 #endif
3645           }
3646         }
3647       }
3648       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3649       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3650       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3651       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3652       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3653       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3654     }
3655     maxneigs = PetscMax(B_neigs,maxneigs);
3656     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3657     if (B_neigs) {
3658       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3659 
3660       if (pcbddc->dbg_flag > 1) {
3661         PetscInt ii;
3662         for (ii=0;ii<B_neigs;ii++) {
3663           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3664           for (j=0;j<B_N;j++) {
3665 #if defined(PETSC_USE_COMPLEX)
3666             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3667             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3668             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3669 #else
3670             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3671 #endif
3672           }
3673         }
3674       }
3675       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3676       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3677       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3678       cum++;
3679     }
3680     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3681     /* shift for next computation */
3682     cumarray += subset_size*subset_size;
3683   }
3684   if (pcbddc->dbg_flag) {
3685     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3686   }
3687 
3688   if (mss) {
3689     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3690     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3691     /* destroy matrices (junk) */
3692     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3693     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3694   }
3695   if (allocated_S_St) {
3696     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3697   }
3698   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3699 #if defined(PETSC_USE_COMPLEX)
3700   ierr = PetscFree(rwork);CHKERRQ(ierr);
3701 #endif
3702   if (pcbddc->dbg_flag) {
3703     PetscInt maxneigs_r;
3704     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3705     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3706   }
3707   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3708   PetscFunctionReturn(0);
3709 }
3710 
3711 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3712 {
3713   PetscScalar    *coarse_submat_vals;
3714   PetscErrorCode ierr;
3715 
3716   PetscFunctionBegin;
3717   /* Setup local scatters R_to_B and (optionally) R_to_D */
3718   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3719   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3720 
3721   /* Setup local neumann solver ksp_R */
3722   /* PCBDDCSetUpLocalScatters should be called first! */
3723   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3724 
3725   /*
3726      Setup local correction and local part of coarse basis.
3727      Gives back the dense local part of the coarse matrix in column major ordering
3728   */
3729   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3730 
3731   /* Compute total number of coarse nodes and setup coarse solver */
3732   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3733 
3734   /* free */
3735   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3736   PetscFunctionReturn(0);
3737 }
3738 
3739 PetscErrorCode PCBDDCResetCustomization(PC pc)
3740 {
3741   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3742   PetscErrorCode ierr;
3743 
3744   PetscFunctionBegin;
3745   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3746   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3747   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3748   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3749   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3750   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3751   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3753   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3754   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3755   PetscFunctionReturn(0);
3756 }
3757 
3758 PetscErrorCode PCBDDCResetTopography(PC pc)
3759 {
3760   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3761   PetscInt       i;
3762   PetscErrorCode ierr;
3763 
3764   PetscFunctionBegin;
3765   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3766   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3767   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3768   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3769   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3770   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3771   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3772   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3773   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3774   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3775   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3776   for (i=0;i<pcbddc->n_local_subs;i++) {
3777     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3778   }
3779   pcbddc->n_local_subs = 0;
3780   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3781   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3782   pcbddc->graphanalyzed        = PETSC_FALSE;
3783   pcbddc->recompute_topography = PETSC_TRUE;
3784   pcbddc->corner_selected      = PETSC_FALSE;
3785   PetscFunctionReturn(0);
3786 }
3787 
3788 PetscErrorCode PCBDDCResetSolvers(PC pc)
3789 {
3790   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3791   PetscErrorCode ierr;
3792 
3793   PetscFunctionBegin;
3794   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3795   if (pcbddc->coarse_phi_B) {
3796     PetscScalar *array;
3797     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3798     ierr = PetscFree(array);CHKERRQ(ierr);
3799   }
3800   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3801   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3802   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3803   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3804   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3805   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3806   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3807   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3809   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3810   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3811   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3812   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3813   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3814   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3815   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3816   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3817   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3818   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3819   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3820   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3821   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3822   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3823   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3824   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3825   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3826   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3827   if (pcbddc->benign_zerodiag_subs) {
3828     PetscInt i;
3829     for (i=0;i<pcbddc->benign_n;i++) {
3830       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3831     }
3832     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3833   }
3834   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3835   PetscFunctionReturn(0);
3836 }
3837 
3838 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3839 {
3840   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3841   PC_IS          *pcis = (PC_IS*)pc->data;
3842   VecType        impVecType;
3843   PetscInt       n_constraints,n_R,old_size;
3844   PetscErrorCode ierr;
3845 
3846   PetscFunctionBegin;
3847   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3848   n_R = pcis->n - pcbddc->n_vertices;
3849   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3850   /* local work vectors (try to avoid unneeded work)*/
3851   /* R nodes */
3852   old_size = -1;
3853   if (pcbddc->vec1_R) {
3854     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3855   }
3856   if (n_R != old_size) {
3857     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3858     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3859     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3860     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3861     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3862     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3863   }
3864   /* local primal dofs */
3865   old_size = -1;
3866   if (pcbddc->vec1_P) {
3867     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3868   }
3869   if (pcbddc->local_primal_size != old_size) {
3870     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3871     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3872     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3873     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3874   }
3875   /* local explicit constraints */
3876   old_size = -1;
3877   if (pcbddc->vec1_C) {
3878     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3879   }
3880   if (n_constraints && n_constraints != old_size) {
3881     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3882     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3883     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3884     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3885   }
3886   PetscFunctionReturn(0);
3887 }
3888 
3889 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3890 {
3891   PetscErrorCode  ierr;
3892   /* pointers to pcis and pcbddc */
3893   PC_IS*          pcis = (PC_IS*)pc->data;
3894   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3895   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3896   /* submatrices of local problem */
3897   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3898   /* submatrices of local coarse problem */
3899   Mat             S_VV,S_CV,S_VC,S_CC;
3900   /* working matrices */
3901   Mat             C_CR;
3902   /* additional working stuff */
3903   PC              pc_R;
3904   Mat             F,Brhs = NULL;
3905   Vec             dummy_vec;
3906   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3907   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3908   PetscScalar     *work;
3909   PetscInt        *idx_V_B;
3910   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3911   PetscInt        i,n_R,n_D,n_B;
3912   PetscScalar     one=1.0,m_one=-1.0;
3913 
3914   PetscFunctionBegin;
3915   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3916   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3917 
3918   /* Set Non-overlapping dimensions */
3919   n_vertices = pcbddc->n_vertices;
3920   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3921   n_B = pcis->n_B;
3922   n_D = pcis->n - n_B;
3923   n_R = pcis->n - n_vertices;
3924 
3925   /* vertices in boundary numbering */
3926   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3927   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3928   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3929 
3930   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3931   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3932   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3933   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3934   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3935   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3936   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3937   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3938   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3939   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3940 
3941   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3942   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3943   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3944   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3945   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3946   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3947   lda_rhs = n_R;
3948   need_benign_correction = PETSC_FALSE;
3949   if (isLU || isILU || isCHOL) {
3950     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3951   } else if (sub_schurs && sub_schurs->reuse_solver) {
3952     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3953     MatFactorType      type;
3954 
3955     F = reuse_solver->F;
3956     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3957     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3958     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3959     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3960   } else {
3961     F = NULL;
3962   }
3963 
3964   /* determine if we can use a sparse right-hand side */
3965   sparserhs = PETSC_FALSE;
3966   if (F) {
3967     MatSolverType solver;
3968 
3969     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3970     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3971   }
3972 
3973   /* allocate workspace */
3974   n = 0;
3975   if (n_constraints) {
3976     n += lda_rhs*n_constraints;
3977   }
3978   if (n_vertices) {
3979     n = PetscMax(2*lda_rhs*n_vertices,n);
3980     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3981   }
3982   if (!pcbddc->symmetric_primal) {
3983     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3984   }
3985   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3986 
3987   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3988   dummy_vec = NULL;
3989   if (need_benign_correction && lda_rhs != n_R && F) {
3990     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3991     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3992     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3993   }
3994 
3995   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3996   if (n_constraints) {
3997     Mat         M3,C_B;
3998     IS          is_aux;
3999     PetscScalar *array,*array2;
4000 
4001     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4002     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4003 
4004     /* Extract constraints on R nodes: C_{CR}  */
4005     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4006     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4007     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4008 
4009     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4010     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4011     if (!sparserhs) {
4012       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4013       for (i=0;i<n_constraints;i++) {
4014         const PetscScalar *row_cmat_values;
4015         const PetscInt    *row_cmat_indices;
4016         PetscInt          size_of_constraint,j;
4017 
4018         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4019         for (j=0;j<size_of_constraint;j++) {
4020           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4021         }
4022         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4023       }
4024       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4025     } else {
4026       Mat tC_CR;
4027 
4028       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4029       if (lda_rhs != n_R) {
4030         PetscScalar *aa;
4031         PetscInt    r,*ii,*jj;
4032         PetscBool   done;
4033 
4034         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4035         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4036         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4037         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4038         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4039         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4040       } else {
4041         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4042         tC_CR = C_CR;
4043       }
4044       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4045       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4046     }
4047     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4048     if (F) {
4049       if (need_benign_correction) {
4050         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4051 
4052         /* rhs is already zero on interior dofs, no need to change the rhs */
4053         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4054       }
4055       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4056       if (need_benign_correction) {
4057         PetscScalar        *marr;
4058         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4059 
4060         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4061         if (lda_rhs != n_R) {
4062           for (i=0;i<n_constraints;i++) {
4063             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4064             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4065             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4066           }
4067         } else {
4068           for (i=0;i<n_constraints;i++) {
4069             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4070             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4071             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4072           }
4073         }
4074         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4075       }
4076     } else {
4077       PetscScalar *marr;
4078 
4079       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4080       for (i=0;i<n_constraints;i++) {
4081         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4082         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4083         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4084         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4085         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4086         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4087       }
4088       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4089     }
4090     if (sparserhs) {
4091       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4092     }
4093     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4094     if (!pcbddc->switch_static) {
4095       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4096       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4097       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4098       for (i=0;i<n_constraints;i++) {
4099         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4100         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4101         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4102         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4103         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4104         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4105       }
4106       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4107       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4108       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4109     } else {
4110       if (lda_rhs != n_R) {
4111         IS dummy;
4112 
4113         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4114         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4115         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4116       } else {
4117         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4118         pcbddc->local_auxmat2 = local_auxmat2_R;
4119       }
4120       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4121     }
4122     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4123     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4124     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4125     if (isCHOL) {
4126       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4127     } else {
4128       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4129     }
4130     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4131     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4132     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4133     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4134     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4135     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4136   }
4137 
4138   /* Get submatrices from subdomain matrix */
4139   if (n_vertices) {
4140     IS is_aux;
4141 
4142     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4143       IS tis;
4144 
4145       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4146       ierr = ISSort(tis);CHKERRQ(ierr);
4147       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4148       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4149     } else {
4150       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4151     }
4152     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4153     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4154     /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4155     ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4156     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4157     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4158   }
4159 
4160   /* Matrix of coarse basis functions (local) */
4161   if (pcbddc->coarse_phi_B) {
4162     PetscInt on_B,on_primal,on_D=n_D;
4163     if (pcbddc->coarse_phi_D) {
4164       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4165     }
4166     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4167     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4168       PetscScalar *marray;
4169 
4170       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4171       ierr = PetscFree(marray);CHKERRQ(ierr);
4172       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4173       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4174       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4175       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4176     }
4177   }
4178 
4179   if (!pcbddc->coarse_phi_B) {
4180     PetscScalar *marr;
4181 
4182     /* memory size */
4183     n = n_B*pcbddc->local_primal_size;
4184     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4185     if (!pcbddc->symmetric_primal) n *= 2;
4186     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4187     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4188     marr += n_B*pcbddc->local_primal_size;
4189     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4190       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4191       marr += n_D*pcbddc->local_primal_size;
4192     }
4193     if (!pcbddc->symmetric_primal) {
4194       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4195       marr += n_B*pcbddc->local_primal_size;
4196       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4197         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4198       }
4199     } else {
4200       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4201       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4202       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4203         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4204         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4205       }
4206     }
4207   }
4208 
4209   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4210   p0_lidx_I = NULL;
4211   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4212     const PetscInt *idxs;
4213 
4214     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4215     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4216     for (i=0;i<pcbddc->benign_n;i++) {
4217       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4218     }
4219     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4220   }
4221 
4222   /* vertices */
4223   if (n_vertices) {
4224     PetscBool restoreavr = PETSC_FALSE;
4225 
4226     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4227 
4228     if (n_R) {
4229       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4230       PetscBLASInt      B_N,B_one = 1;
4231       const PetscScalar *x;
4232       PetscScalar       *y;
4233 
4234       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4235       if (need_benign_correction) {
4236         ISLocalToGlobalMapping RtoN;
4237         IS                     is_p0;
4238         PetscInt               *idxs_p0,n;
4239 
4240         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4241         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4242         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4243         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);
4244         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4245         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4246         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4247         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4248       }
4249 
4250       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4251       if (!sparserhs || need_benign_correction) {
4252         if (lda_rhs == n_R) {
4253           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4254         } else {
4255           PetscScalar    *av,*array;
4256           const PetscInt *xadj,*adjncy;
4257           PetscInt       n;
4258           PetscBool      flg_row;
4259 
4260           array = work+lda_rhs*n_vertices;
4261           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4262           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4263           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4264           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4265           for (i=0;i<n;i++) {
4266             PetscInt j;
4267             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4268           }
4269           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4270           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4271           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4272         }
4273         if (need_benign_correction) {
4274           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4275           PetscScalar        *marr;
4276 
4277           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4278           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4279 
4280                  | 0 0  0 | (V)
4281              L = | 0 0 -1 | (P-p0)
4282                  | 0 0 -1 | (p0)
4283 
4284           */
4285           for (i=0;i<reuse_solver->benign_n;i++) {
4286             const PetscScalar *vals;
4287             const PetscInt    *idxs,*idxs_zero;
4288             PetscInt          n,j,nz;
4289 
4290             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4291             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4292             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4293             for (j=0;j<n;j++) {
4294               PetscScalar val = vals[j];
4295               PetscInt    k,col = idxs[j];
4296               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4297             }
4298             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4299             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4300           }
4301           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4302         }
4303         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4304         Brhs = A_RV;
4305       } else {
4306         Mat tA_RVT,A_RVT;
4307 
4308         if (!pcbddc->symmetric_primal) {
4309           /* A_RV already scaled by -1 */
4310           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4311         } else {
4312           restoreavr = PETSC_TRUE;
4313           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4314           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4315           A_RVT = A_VR;
4316         }
4317         if (lda_rhs != n_R) {
4318           PetscScalar *aa;
4319           PetscInt    r,*ii,*jj;
4320           PetscBool   done;
4321 
4322           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4323           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4324           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4325           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4326           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4327           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4328         } else {
4329           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4330           tA_RVT = A_RVT;
4331         }
4332         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4333         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4334         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4335       }
4336       if (F) {
4337         /* need to correct the rhs */
4338         if (need_benign_correction) {
4339           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4340           PetscScalar        *marr;
4341 
4342           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4343           if (lda_rhs != n_R) {
4344             for (i=0;i<n_vertices;i++) {
4345               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4346               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4347               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4348             }
4349           } else {
4350             for (i=0;i<n_vertices;i++) {
4351               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4352               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4353               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4354             }
4355           }
4356           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4357         }
4358         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4359         if (restoreavr) {
4360           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4361         }
4362         /* need to correct the solution */
4363         if (need_benign_correction) {
4364           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4365           PetscScalar        *marr;
4366 
4367           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4368           if (lda_rhs != n_R) {
4369             for (i=0;i<n_vertices;i++) {
4370               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4371               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4372               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4373             }
4374           } else {
4375             for (i=0;i<n_vertices;i++) {
4376               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4377               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4378               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4379             }
4380           }
4381           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4382         }
4383       } else {
4384         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4385         for (i=0;i<n_vertices;i++) {
4386           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4387           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4388           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4389           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4390           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4391           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4392         }
4393         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4394       }
4395       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4396       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4397       /* S_VV and S_CV */
4398       if (n_constraints) {
4399         Mat B;
4400 
4401         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4402         for (i=0;i<n_vertices;i++) {
4403           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4404           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4405           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4406           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4407           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4408           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4409         }
4410         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4411         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4412         ierr = MatDestroy(&B);CHKERRQ(ierr);
4413         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4414         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4415         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4416         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4417         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4418         ierr = MatDestroy(&B);CHKERRQ(ierr);
4419       }
4420       if (lda_rhs != n_R) {
4421         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4422         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4423         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4424       }
4425       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4426       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4427       if (need_benign_correction) {
4428         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4429         PetscScalar      *marr,*sums;
4430 
4431         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4432         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4433         for (i=0;i<reuse_solver->benign_n;i++) {
4434           const PetscScalar *vals;
4435           const PetscInt    *idxs,*idxs_zero;
4436           PetscInt          n,j,nz;
4437 
4438           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4439           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4440           for (j=0;j<n_vertices;j++) {
4441             PetscInt k;
4442             sums[j] = 0.;
4443             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4444           }
4445           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4446           for (j=0;j<n;j++) {
4447             PetscScalar val = vals[j];
4448             PetscInt k;
4449             for (k=0;k<n_vertices;k++) {
4450               marr[idxs[j]+k*n_vertices] += val*sums[k];
4451             }
4452           }
4453           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4454           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4455         }
4456         ierr = PetscFree(sums);CHKERRQ(ierr);
4457         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4458         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4459       }
4460       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4461       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4462       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4463       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4464       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4465       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4466       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4467       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4468       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4469     } else {
4470       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4471     }
4472     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4473 
4474     /* coarse basis functions */
4475     for (i=0;i<n_vertices;i++) {
4476       PetscScalar *y;
4477 
4478       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4479       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4480       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4481       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4482       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4483       y[n_B*i+idx_V_B[i]] = 1.0;
4484       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4485       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4486 
4487       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4488         PetscInt j;
4489 
4490         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4491         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4492         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4493         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4494         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4495         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4496         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4497       }
4498       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4499     }
4500     /* if n_R == 0 the object is not destroyed */
4501     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4502   }
4503   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4504 
4505   if (n_constraints) {
4506     Mat B;
4507 
4508     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4509     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4510     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4511     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4512     if (n_vertices) {
4513       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4514         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4515       } else {
4516         Mat S_VCt;
4517 
4518         if (lda_rhs != n_R) {
4519           ierr = MatDestroy(&B);CHKERRQ(ierr);
4520           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4521           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4522         }
4523         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4524         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4525         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4526       }
4527     }
4528     ierr = MatDestroy(&B);CHKERRQ(ierr);
4529     /* coarse basis functions */
4530     for (i=0;i<n_constraints;i++) {
4531       PetscScalar *y;
4532 
4533       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4534       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4535       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4536       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4537       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4538       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4539       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4540       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4541         PetscInt j;
4542 
4543         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4544         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4545         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4546         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4547         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4548         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4549         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4550       }
4551       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4552     }
4553   }
4554   if (n_constraints) {
4555     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4556   }
4557   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4558 
4559   /* coarse matrix entries relative to B_0 */
4560   if (pcbddc->benign_n) {
4561     Mat               B0_B,B0_BPHI;
4562     IS                is_dummy;
4563     const PetscScalar *data;
4564     PetscInt          j;
4565 
4566     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4567     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4568     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4569     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4570     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4571     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4572     for (j=0;j<pcbddc->benign_n;j++) {
4573       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4574       for (i=0;i<pcbddc->local_primal_size;i++) {
4575         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4576         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4577       }
4578     }
4579     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4580     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4581     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4582   }
4583 
4584   /* compute other basis functions for non-symmetric problems */
4585   if (!pcbddc->symmetric_primal) {
4586     Mat         B_V=NULL,B_C=NULL;
4587     PetscScalar *marray;
4588 
4589     if (n_constraints) {
4590       Mat S_CCT,C_CRT;
4591 
4592       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4593       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4594       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4595       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4596       if (n_vertices) {
4597         Mat S_VCT;
4598 
4599         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4600         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4601         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4602       }
4603       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4604     } else {
4605       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4606     }
4607     if (n_vertices && n_R) {
4608       PetscScalar    *av,*marray;
4609       const PetscInt *xadj,*adjncy;
4610       PetscInt       n;
4611       PetscBool      flg_row;
4612 
4613       /* B_V = B_V - A_VR^T */
4614       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4615       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4616       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4617       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4618       for (i=0;i<n;i++) {
4619         PetscInt j;
4620         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4621       }
4622       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4623       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4624       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4625     }
4626 
4627     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4628     if (n_vertices) {
4629       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4630       for (i=0;i<n_vertices;i++) {
4631         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4632         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4633         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4634         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4635         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4636         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4637       }
4638       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4639     }
4640     if (B_C) {
4641       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4642       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4643         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4644         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4645         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4646         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4647         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4648         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4649       }
4650       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4651     }
4652     /* coarse basis functions */
4653     for (i=0;i<pcbddc->local_primal_size;i++) {
4654       PetscScalar *y;
4655 
4656       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4657       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4658       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4659       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4660       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4661       if (i<n_vertices) {
4662         y[n_B*i+idx_V_B[i]] = 1.0;
4663       }
4664       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4665       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4666 
4667       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4668         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4669         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4670         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4671         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4672         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4673         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4674       }
4675       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4676     }
4677     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4678     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4679   }
4680 
4681   /* free memory */
4682   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4683   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4684   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4685   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4686   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4687   ierr = PetscFree(work);CHKERRQ(ierr);
4688   if (n_vertices) {
4689     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4690   }
4691   if (n_constraints) {
4692     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4693   }
4694   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4695 
4696   /* Checking coarse_sub_mat and coarse basis functios */
4697   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4698   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4699   if (pcbddc->dbg_flag) {
4700     Mat         coarse_sub_mat;
4701     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4702     Mat         coarse_phi_D,coarse_phi_B;
4703     Mat         coarse_psi_D,coarse_psi_B;
4704     Mat         A_II,A_BB,A_IB,A_BI;
4705     Mat         C_B,CPHI;
4706     IS          is_dummy;
4707     Vec         mones;
4708     MatType     checkmattype=MATSEQAIJ;
4709     PetscReal   real_value;
4710 
4711     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4712       Mat A;
4713       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4714       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4715       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4716       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4717       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4718       ierr = MatDestroy(&A);CHKERRQ(ierr);
4719     } else {
4720       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4721       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4722       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4723       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4724     }
4725     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4726     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4727     if (!pcbddc->symmetric_primal) {
4728       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4729       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4730     }
4731     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4732 
4733     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4734     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4735     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4736     if (!pcbddc->symmetric_primal) {
4737       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4738       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4739       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4740       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4741       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4742       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4743       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4744       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4745       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4746       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4747       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4748       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4749     } else {
4750       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4751       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4752       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4753       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4754       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4755       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4756       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4757       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4758     }
4759     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4760     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4761     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4762     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4763     if (pcbddc->benign_n) {
4764       Mat               B0_B,B0_BPHI;
4765       const PetscScalar *data2;
4766       PetscScalar       *data;
4767       PetscInt          j;
4768 
4769       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4770       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4771       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4772       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4773       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4774       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4775       for (j=0;j<pcbddc->benign_n;j++) {
4776         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4777         for (i=0;i<pcbddc->local_primal_size;i++) {
4778           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4779           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4780         }
4781       }
4782       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4783       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4784       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4785       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4786       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4787     }
4788 #if 0
4789   {
4790     PetscViewer viewer;
4791     char filename[256];
4792     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4793     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4794     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4795     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4796     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4797     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4798     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4799     if (pcbddc->coarse_phi_B) {
4800       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4801       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4802     }
4803     if (pcbddc->coarse_phi_D) {
4804       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4805       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4806     }
4807     if (pcbddc->coarse_psi_B) {
4808       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4809       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4810     }
4811     if (pcbddc->coarse_psi_D) {
4812       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4813       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4814     }
4815     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4816     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4817     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4818     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4819     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4820     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4821     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4822     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4823     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4824     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4825     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4826   }
4827 #endif
4828     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4829     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4830     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4831     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4832 
4833     /* check constraints */
4834     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4835     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4836     if (!pcbddc->benign_n) { /* TODO: add benign case */
4837       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4838     } else {
4839       PetscScalar *data;
4840       Mat         tmat;
4841       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4842       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4843       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4844       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4845       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4846     }
4847     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4848     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4849     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4850     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4851     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4852     if (!pcbddc->symmetric_primal) {
4853       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4854       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4855       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4856       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4857       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4858     }
4859     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4860     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4861     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4862     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4863     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4864     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4865     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4866     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4867     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4868     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4869     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4870     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4871     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4872     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4873     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4874     if (!pcbddc->symmetric_primal) {
4875       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4876       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4877     }
4878     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4879   }
4880   /* get back data */
4881   *coarse_submat_vals_n = coarse_submat_vals;
4882   PetscFunctionReturn(0);
4883 }
4884 
4885 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4886 {
4887   Mat            *work_mat;
4888   IS             isrow_s,iscol_s;
4889   PetscBool      rsorted,csorted;
4890   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4891   PetscErrorCode ierr;
4892 
4893   PetscFunctionBegin;
4894   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4895   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4896   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4897   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4898 
4899   if (!rsorted) {
4900     const PetscInt *idxs;
4901     PetscInt *idxs_sorted,i;
4902 
4903     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4904     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4905     for (i=0;i<rsize;i++) {
4906       idxs_perm_r[i] = i;
4907     }
4908     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4909     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4910     for (i=0;i<rsize;i++) {
4911       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4912     }
4913     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4914     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4915   } else {
4916     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4917     isrow_s = isrow;
4918   }
4919 
4920   if (!csorted) {
4921     if (isrow == iscol) {
4922       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4923       iscol_s = isrow_s;
4924     } else {
4925       const PetscInt *idxs;
4926       PetscInt       *idxs_sorted,i;
4927 
4928       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4929       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4930       for (i=0;i<csize;i++) {
4931         idxs_perm_c[i] = i;
4932       }
4933       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4934       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4935       for (i=0;i<csize;i++) {
4936         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4937       }
4938       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4939       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4940     }
4941   } else {
4942     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4943     iscol_s = iscol;
4944   }
4945 
4946   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4947 
4948   if (!rsorted || !csorted) {
4949     Mat      new_mat;
4950     IS       is_perm_r,is_perm_c;
4951 
4952     if (!rsorted) {
4953       PetscInt *idxs_r,i;
4954       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4955       for (i=0;i<rsize;i++) {
4956         idxs_r[idxs_perm_r[i]] = i;
4957       }
4958       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4959       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4960     } else {
4961       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4962     }
4963     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4964 
4965     if (!csorted) {
4966       if (isrow_s == iscol_s) {
4967         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4968         is_perm_c = is_perm_r;
4969       } else {
4970         PetscInt *idxs_c,i;
4971         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4972         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4973         for (i=0;i<csize;i++) {
4974           idxs_c[idxs_perm_c[i]] = i;
4975         }
4976         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4977         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4978       }
4979     } else {
4980       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4981     }
4982     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4983 
4984     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4985     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4986     work_mat[0] = new_mat;
4987     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4988     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4989   }
4990 
4991   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4992   *B = work_mat[0];
4993   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4994   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4995   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4996   PetscFunctionReturn(0);
4997 }
4998 
4999 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5000 {
5001   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5002   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5003   Mat            new_mat,lA;
5004   IS             is_local,is_global;
5005   PetscInt       local_size;
5006   PetscBool      isseqaij;
5007   PetscErrorCode ierr;
5008 
5009   PetscFunctionBegin;
5010   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5011   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5012   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5013   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5014   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5015   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5016   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5017 
5018   if (pcbddc->dbg_flag) {
5019     Vec       x,x_change;
5020     PetscReal error;
5021 
5022     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5023     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5024     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5025     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5026     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5027     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5028     if (!pcbddc->change_interior) {
5029       const PetscScalar *x,*y,*v;
5030       PetscReal         lerror = 0.;
5031       PetscInt          i;
5032 
5033       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5034       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5035       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5036       for (i=0;i<local_size;i++)
5037         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5038           lerror = PetscAbsScalar(x[i]-y[i]);
5039       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5040       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5041       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5042       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5043       if (error > PETSC_SMALL) {
5044         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5045           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5046         } else {
5047           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5048         }
5049       }
5050     }
5051     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5052     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5053     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5054     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5055     if (error > PETSC_SMALL) {
5056       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5057         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5058       } else {
5059         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5060       }
5061     }
5062     ierr = VecDestroy(&x);CHKERRQ(ierr);
5063     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5064   }
5065 
5066   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5067   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5068 
5069   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5070   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5071   if (isseqaij) {
5072     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5073     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5074     if (lA) {
5075       Mat work;
5076       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5077       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5078       ierr = MatDestroy(&work);CHKERRQ(ierr);
5079     }
5080   } else {
5081     Mat work_mat;
5082 
5083     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5084     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5085     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5086     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5087     if (lA) {
5088       Mat work;
5089       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5090       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5091       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5092       ierr = MatDestroy(&work);CHKERRQ(ierr);
5093     }
5094   }
5095   if (matis->A->symmetric_set) {
5096     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5097 #if !defined(PETSC_USE_COMPLEX)
5098     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5099 #endif
5100   }
5101   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5102   PetscFunctionReturn(0);
5103 }
5104 
5105 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5106 {
5107   PC_IS*          pcis = (PC_IS*)(pc->data);
5108   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5109   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5110   PetscInt        *idx_R_local=NULL;
5111   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5112   PetscInt        vbs,bs;
5113   PetscBT         bitmask=NULL;
5114   PetscErrorCode  ierr;
5115 
5116   PetscFunctionBegin;
5117   /*
5118     No need to setup local scatters if
5119       - primal space is unchanged
5120         AND
5121       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5122         AND
5123       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5124   */
5125   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5126     PetscFunctionReturn(0);
5127   }
5128   /* destroy old objects */
5129   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5130   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5131   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5132   /* Set Non-overlapping dimensions */
5133   n_B = pcis->n_B;
5134   n_D = pcis->n - n_B;
5135   n_vertices = pcbddc->n_vertices;
5136 
5137   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5138 
5139   /* create auxiliary bitmask and allocate workspace */
5140   if (!sub_schurs || !sub_schurs->reuse_solver) {
5141     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5142     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5143     for (i=0;i<n_vertices;i++) {
5144       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5145     }
5146 
5147     for (i=0, n_R=0; i<pcis->n; i++) {
5148       if (!PetscBTLookup(bitmask,i)) {
5149         idx_R_local[n_R++] = i;
5150       }
5151     }
5152   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5153     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5154 
5155     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5156     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5157   }
5158 
5159   /* Block code */
5160   vbs = 1;
5161   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5162   if (bs>1 && !(n_vertices%bs)) {
5163     PetscBool is_blocked = PETSC_TRUE;
5164     PetscInt  *vary;
5165     if (!sub_schurs || !sub_schurs->reuse_solver) {
5166       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5167       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5168       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5169       /* 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 */
5170       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5171       for (i=0; i<pcis->n/bs; i++) {
5172         if (vary[i]!=0 && vary[i]!=bs) {
5173           is_blocked = PETSC_FALSE;
5174           break;
5175         }
5176       }
5177       ierr = PetscFree(vary);CHKERRQ(ierr);
5178     } else {
5179       /* Verify directly the R set */
5180       for (i=0; i<n_R/bs; i++) {
5181         PetscInt j,node=idx_R_local[bs*i];
5182         for (j=1; j<bs; j++) {
5183           if (node != idx_R_local[bs*i+j]-j) {
5184             is_blocked = PETSC_FALSE;
5185             break;
5186           }
5187         }
5188       }
5189     }
5190     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5191       vbs = bs;
5192       for (i=0;i<n_R/vbs;i++) {
5193         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5194       }
5195     }
5196   }
5197   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5198   if (sub_schurs && sub_schurs->reuse_solver) {
5199     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5200 
5201     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5202     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5203     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5204     reuse_solver->is_R = pcbddc->is_R_local;
5205   } else {
5206     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5207   }
5208 
5209   /* print some info if requested */
5210   if (pcbddc->dbg_flag) {
5211     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5212     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5213     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5214     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5215     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5216     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);
5217     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218   }
5219 
5220   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5221   if (!sub_schurs || !sub_schurs->reuse_solver) {
5222     IS       is_aux1,is_aux2;
5223     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5224 
5225     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5226     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5227     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5228     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5229     for (i=0; i<n_D; i++) {
5230       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5231     }
5232     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5233     for (i=0, j=0; i<n_R; i++) {
5234       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5235         aux_array1[j++] = i;
5236       }
5237     }
5238     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5239     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5240     for (i=0, j=0; i<n_B; i++) {
5241       if (!PetscBTLookup(bitmask,is_indices[i])) {
5242         aux_array2[j++] = i;
5243       }
5244     }
5245     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5246     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5247     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5248     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5249     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5250 
5251     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5252       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5253       for (i=0, j=0; i<n_R; i++) {
5254         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5255           aux_array1[j++] = i;
5256         }
5257       }
5258       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5259       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5260       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5261     }
5262     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5263     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5264   } else {
5265     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5266     IS                 tis;
5267     PetscInt           schur_size;
5268 
5269     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5270     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5271     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5272     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5273     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5274       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5275       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5276       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5277     }
5278   }
5279   PetscFunctionReturn(0);
5280 }
5281 
5282 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5283 {
5284   MatNullSpace   NullSpace;
5285   Mat            dmat;
5286   const Vec      *nullvecs;
5287   Vec            v,v2,*nullvecs2;
5288   VecScatter     sct = NULL;
5289   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5290   PetscBool      nnsp_has_cnst;
5291   PetscErrorCode ierr;
5292 
5293   PetscFunctionBegin;
5294   if (!is && !B) { /* MATIS */
5295     Mat_IS* matis = (Mat_IS*)A->data;
5296 
5297     if (!B) {
5298       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5299     }
5300     sct  = matis->cctx;
5301     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5302   } else {
5303     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5304     if (!NullSpace) {
5305       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5306     }
5307     if (NullSpace) PetscFunctionReturn(0);
5308   }
5309   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5310   if (!NullSpace) {
5311     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5312   }
5313   if (!NullSpace) PetscFunctionReturn(0);
5314 
5315   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5316   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5317   if (!sct) {
5318     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5319   }
5320   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5321   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5322   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5323   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5324   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5325   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5326   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5327   for (k=0;k<nnsp_size;k++) {
5328     PetscScalar *arr;
5329 
5330     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5331     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5332     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5333     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5334     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5335   }
5336   if (nnsp_has_cnst) {
5337     PetscScalar *arr;
5338 
5339     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5340     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5341     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5342     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5343   }
5344   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5345   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5346   if (bsiz2 != bsiz) {
5347     Mat      dmat2;
5348     IS       r,c;
5349     PetscInt rst,ren;
5350 
5351     ierr = MatGetOwnershipRange(dmat,&rst,&ren);CHKERRQ(ierr);
5352     ierr = ISCreateStride(PetscObjectComm((PetscObject)B),ren-rst,rst,1,&r);CHKERRQ(ierr);
5353     ierr = ISCreateStride(PetscObjectComm((PetscObject)B),0,bsiz2,1,&c);CHKERRQ(ierr);
5354     ierr = MatCreateSubMatrix(dmat,r,c,MAT_INITIAL_MATRIX,&dmat2);CHKERRQ(ierr);
5355     ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5356     ierr = ISDestroy(&r);CHKERRQ(ierr);
5357     ierr = ISDestroy(&c);CHKERRQ(ierr);
5358     dmat = dmat2;
5359   }
5360   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5361   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5362   for (k=0;k<bsiz;k++) {
5363     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5364   }
5365   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5366   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5367   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5368   ierr = VecDestroy(&v);CHKERRQ(ierr);
5369   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5370   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5371   PetscFunctionReturn(0);
5372 }
5373 
5374 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5375 {
5376   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5377   PC_IS          *pcis = (PC_IS*)pc->data;
5378   PC             pc_temp;
5379   Mat            A_RR;
5380   MatNullSpace   nnsp;
5381   MatReuse       reuse;
5382   PetscScalar    m_one = -1.0;
5383   PetscReal      value;
5384   PetscInt       n_D,n_R;
5385   PetscBool      issbaij,opts;
5386   PetscErrorCode ierr;
5387   void           (*f)(void) = 0;
5388   char           dir_prefix[256],neu_prefix[256],str_level[16];
5389   size_t         len;
5390 
5391   PetscFunctionBegin;
5392   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5393   /* approximate solver, propagate NearNullSpace if needed */
5394   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5395     MatNullSpace gnnsp1,gnnsp2;
5396     PetscBool    lhas,ghas;
5397 
5398     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5399     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5400     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5401     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5402     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5403     if (!ghas && (gnnsp1 || gnnsp2)) {
5404       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5405     }
5406   }
5407 
5408   /* compute prefixes */
5409   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5410   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5411   if (!pcbddc->current_level) {
5412     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5413     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5414     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5415     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5416   } else {
5417     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5418     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5419     len -= 15; /* remove "pc_bddc_coarse_" */
5420     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5421     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5422     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5423     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5424     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5425     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5426     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5427     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5428     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5429   }
5430 
5431   /* DIRICHLET PROBLEM */
5432   if (dirichlet) {
5433     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5434     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5435       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5436       if (pcbddc->dbg_flag) {
5437         Mat    A_IIn;
5438 
5439         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5440         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5441         pcis->A_II = A_IIn;
5442       }
5443     }
5444     if (pcbddc->local_mat->symmetric_set) {
5445       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5446     }
5447     /* Matrix for Dirichlet problem is pcis->A_II */
5448     n_D  = pcis->n - pcis->n_B;
5449     opts = PETSC_FALSE;
5450     if (!pcbddc->ksp_D) { /* create object if not yet build */
5451       opts = PETSC_TRUE;
5452       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5453       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5454       /* default */
5455       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5456       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5457       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5458       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5459       if (issbaij) {
5460         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5461       } else {
5462         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5463       }
5464       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5465     }
5466     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5467     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5468     /* Allow user's customization */
5469     if (opts) {
5470       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5471     }
5472     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5473     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5474       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5475     }
5476     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5477     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5478     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5479     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5480       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5481       const PetscInt *idxs;
5482       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5483 
5484       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5485       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5486       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5487       for (i=0;i<nl;i++) {
5488         for (d=0;d<cdim;d++) {
5489           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5490         }
5491       }
5492       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5493       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5494       ierr = PetscFree(scoords);CHKERRQ(ierr);
5495     }
5496     if (sub_schurs && sub_schurs->reuse_solver) {
5497       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5498 
5499       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5500     }
5501 
5502     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5503     if (!n_D) {
5504       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5505       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5506     }
5507     /* set ksp_D into pcis data */
5508     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5509     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5510     pcis->ksp_D = pcbddc->ksp_D;
5511   }
5512 
5513   /* NEUMANN PROBLEM */
5514   A_RR = 0;
5515   if (neumann) {
5516     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5517     PetscInt        ibs,mbs;
5518     PetscBool       issbaij, reuse_neumann_solver;
5519     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5520 
5521     reuse_neumann_solver = PETSC_FALSE;
5522     if (sub_schurs && sub_schurs->reuse_solver) {
5523       IS iP;
5524 
5525       reuse_neumann_solver = PETSC_TRUE;
5526       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5527       if (iP) reuse_neumann_solver = PETSC_FALSE;
5528     }
5529     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5530     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5531     if (pcbddc->ksp_R) { /* already created ksp */
5532       PetscInt nn_R;
5533       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5534       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5535       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5536       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5537         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5538         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5539         reuse = MAT_INITIAL_MATRIX;
5540       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5541         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5542           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5543           reuse = MAT_INITIAL_MATRIX;
5544         } else { /* safe to reuse the matrix */
5545           reuse = MAT_REUSE_MATRIX;
5546         }
5547       }
5548       /* last check */
5549       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5550         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5551         reuse = MAT_INITIAL_MATRIX;
5552       }
5553     } else { /* first time, so we need to create the matrix */
5554       reuse = MAT_INITIAL_MATRIX;
5555     }
5556     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5557     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5558     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5559     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5560     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5561       if (matis->A == pcbddc->local_mat) {
5562         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5563         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5564       } else {
5565         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5566       }
5567     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5568       if (matis->A == pcbddc->local_mat) {
5569         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5570         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5571       } else {
5572         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5573       }
5574     }
5575     /* extract A_RR */
5576     if (reuse_neumann_solver) {
5577       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5578 
5579       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5580         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5581         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5582           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5583         } else {
5584           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5585         }
5586       } else {
5587         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5588         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5589         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5590       }
5591     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5592       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5593     }
5594     if (pcbddc->local_mat->symmetric_set) {
5595       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5596     }
5597     opts = PETSC_FALSE;
5598     if (!pcbddc->ksp_R) { /* create object if not present */
5599       opts = PETSC_TRUE;
5600       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5601       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5602       /* default */
5603       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5604       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5605       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5606       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5607       if (issbaij) {
5608         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5609       } else {
5610         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5611       }
5612       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5613     }
5614     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5615     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5616     if (opts) { /* Allow user's customization once */
5617       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5618     }
5619     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5620     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5621       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5622     }
5623     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5624     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5625     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5626     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5627       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5628       const PetscInt *idxs;
5629       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5630 
5631       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5632       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5633       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5634       for (i=0;i<nl;i++) {
5635         for (d=0;d<cdim;d++) {
5636           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5637         }
5638       }
5639       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5640       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5641       ierr = PetscFree(scoords);CHKERRQ(ierr);
5642     }
5643 
5644     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5645     if (!n_R) {
5646       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5647       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5648     }
5649     /* Reuse solver if it is present */
5650     if (reuse_neumann_solver) {
5651       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5652 
5653       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5654     }
5655   }
5656 
5657   if (pcbddc->dbg_flag) {
5658     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5659     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5660     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5661   }
5662   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5663 
5664   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5665   if (pcbddc->NullSpace_corr[0]) {
5666     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5667   }
5668   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5669     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5670   }
5671   if (neumann && pcbddc->NullSpace_corr[2]) {
5672     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5673   }
5674   /* check Dirichlet and Neumann solvers */
5675   if (pcbddc->dbg_flag) {
5676     if (dirichlet) { /* Dirichlet */
5677       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5678       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5679       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5680       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5681       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5682       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5683       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);
5684       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5685     }
5686     if (neumann) { /* Neumann */
5687       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5688       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5689       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5690       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5691       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5692       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5693       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);
5694       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5695     }
5696   }
5697   /* free Neumann problem's matrix */
5698   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5699   PetscFunctionReturn(0);
5700 }
5701 
5702 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5703 {
5704   PetscErrorCode  ierr;
5705   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5706   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5707   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5708 
5709   PetscFunctionBegin;
5710   if (!reuse_solver) {
5711     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5712   }
5713   if (!pcbddc->switch_static) {
5714     if (applytranspose && pcbddc->local_auxmat1) {
5715       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5716       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5717     }
5718     if (!reuse_solver) {
5719       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5720       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5721     } else {
5722       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5723 
5724       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5725       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5726     }
5727   } else {
5728     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5729     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5730     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5731     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5732     if (applytranspose && pcbddc->local_auxmat1) {
5733       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5734       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5735       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5736       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5737     }
5738   }
5739   if (!reuse_solver || pcbddc->switch_static) {
5740     if (applytranspose) {
5741       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5742     } else {
5743       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5744     }
5745     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5746   } else {
5747     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5748 
5749     if (applytranspose) {
5750       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5751     } else {
5752       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5753     }
5754   }
5755   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5756   if (!pcbddc->switch_static) {
5757     if (!reuse_solver) {
5758       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5759       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5760     } else {
5761       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5762 
5763       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5764       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5765     }
5766     if (!applytranspose && pcbddc->local_auxmat1) {
5767       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5768       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5769     }
5770   } else {
5771     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5772     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5773     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5774     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5775     if (!applytranspose && pcbddc->local_auxmat1) {
5776       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5777       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5778     }
5779     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5780     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5781     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5782     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5783   }
5784   PetscFunctionReturn(0);
5785 }
5786 
5787 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5788 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5789 {
5790   PetscErrorCode ierr;
5791   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5792   PC_IS*            pcis = (PC_IS*)  (pc->data);
5793   const PetscScalar zero = 0.0;
5794 
5795   PetscFunctionBegin;
5796   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5797   if (!pcbddc->benign_apply_coarse_only) {
5798     if (applytranspose) {
5799       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5800       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5801     } else {
5802       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5803       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5804     }
5805   } else {
5806     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5807   }
5808 
5809   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5810   if (pcbddc->benign_n) {
5811     PetscScalar *array;
5812     PetscInt    j;
5813 
5814     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5815     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5816     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5817   }
5818 
5819   /* start communications from local primal nodes to rhs of coarse solver */
5820   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5821   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5822   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5823 
5824   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5825   if (pcbddc->coarse_ksp) {
5826     Mat          coarse_mat;
5827     Vec          rhs,sol;
5828     MatNullSpace nullsp;
5829     PetscBool    isbddc = PETSC_FALSE;
5830 
5831     if (pcbddc->benign_have_null) {
5832       PC        coarse_pc;
5833 
5834       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5835       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5836       /* we need to propagate to coarser levels the need for a possible benign correction */
5837       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5838         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5839         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5840         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5841       }
5842     }
5843     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5844     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5845     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5846     if (applytranspose) {
5847       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5848       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5849       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5850       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5851       if (nullsp) {
5852         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5853       }
5854     } else {
5855       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5856       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5857         PC        coarse_pc;
5858 
5859         if (nullsp) {
5860           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5861         }
5862         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5863         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5864         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5865         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5866       } else {
5867         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5868         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5869         if (nullsp) {
5870           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5871         }
5872       }
5873     }
5874     /* we don't need the benign correction at coarser levels anymore */
5875     if (pcbddc->benign_have_null && isbddc) {
5876       PC        coarse_pc;
5877       PC_BDDC*  coarsepcbddc;
5878 
5879       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5880       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5881       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5882       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5883     }
5884   }
5885 
5886   /* Local solution on R nodes */
5887   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5888     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5889   }
5890   /* communications from coarse sol to local primal nodes */
5891   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5892   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5893 
5894   /* Sum contributions from the two levels */
5895   if (!pcbddc->benign_apply_coarse_only) {
5896     if (applytranspose) {
5897       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5898       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5899     } else {
5900       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5901       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5902     }
5903     /* store p0 */
5904     if (pcbddc->benign_n) {
5905       PetscScalar *array;
5906       PetscInt    j;
5907 
5908       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5909       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5910       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5911     }
5912   } else { /* expand the coarse solution */
5913     if (applytranspose) {
5914       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5915     } else {
5916       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5917     }
5918   }
5919   PetscFunctionReturn(0);
5920 }
5921 
5922 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5923 {
5924   PetscErrorCode ierr;
5925   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5926   PetscScalar    *array;
5927   Vec            from,to;
5928 
5929   PetscFunctionBegin;
5930   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5931     from = pcbddc->coarse_vec;
5932     to = pcbddc->vec1_P;
5933     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5934       Vec tvec;
5935 
5936       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5937       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5938       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5939       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5940       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5941       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5942     }
5943   } else { /* from local to global -> put data in coarse right hand side */
5944     from = pcbddc->vec1_P;
5945     to = pcbddc->coarse_vec;
5946   }
5947   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5948   PetscFunctionReturn(0);
5949 }
5950 
5951 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5952 {
5953   PetscErrorCode ierr;
5954   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5955   PetscScalar    *array;
5956   Vec            from,to;
5957 
5958   PetscFunctionBegin;
5959   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5960     from = pcbddc->coarse_vec;
5961     to = pcbddc->vec1_P;
5962   } else { /* from local to global -> put data in coarse right hand side */
5963     from = pcbddc->vec1_P;
5964     to = pcbddc->coarse_vec;
5965   }
5966   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5967   if (smode == SCATTER_FORWARD) {
5968     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5969       Vec tvec;
5970 
5971       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5972       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5973       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5974       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5975     }
5976   } else {
5977     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5978      ierr = VecResetArray(from);CHKERRQ(ierr);
5979     }
5980   }
5981   PetscFunctionReturn(0);
5982 }
5983 
5984 /* uncomment for testing purposes */
5985 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5986 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5987 {
5988   PetscErrorCode    ierr;
5989   PC_IS*            pcis = (PC_IS*)(pc->data);
5990   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5991   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5992   /* one and zero */
5993   PetscScalar       one=1.0,zero=0.0;
5994   /* space to store constraints and their local indices */
5995   PetscScalar       *constraints_data;
5996   PetscInt          *constraints_idxs,*constraints_idxs_B;
5997   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5998   PetscInt          *constraints_n;
5999   /* iterators */
6000   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6001   /* BLAS integers */
6002   PetscBLASInt      lwork,lierr;
6003   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6004   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6005   /* reuse */
6006   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6007   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6008   /* change of basis */
6009   PetscBool         qr_needed;
6010   PetscBT           change_basis,qr_needed_idx;
6011   /* auxiliary stuff */
6012   PetscInt          *nnz,*is_indices;
6013   PetscInt          ncc;
6014   /* some quantities */
6015   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6016   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6017   PetscReal         tol; /* tolerance for retaining eigenmodes */
6018 
6019   PetscFunctionBegin;
6020   tol  = PetscSqrtReal(PETSC_SMALL);
6021   /* Destroy Mat objects computed previously */
6022   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6023   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6024   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6025   /* save info on constraints from previous setup (if any) */
6026   olocal_primal_size = pcbddc->local_primal_size;
6027   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6028   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6029   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6030   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6031   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6032   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6033 
6034   if (!pcbddc->adaptive_selection) {
6035     IS           ISForVertices,*ISForFaces,*ISForEdges;
6036     MatNullSpace nearnullsp;
6037     const Vec    *nearnullvecs;
6038     Vec          *localnearnullsp;
6039     PetscScalar  *array;
6040     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6041     PetscBool    nnsp_has_cnst;
6042     /* LAPACK working arrays for SVD or POD */
6043     PetscBool    skip_lapack,boolforchange;
6044     PetscScalar  *work;
6045     PetscReal    *singular_vals;
6046 #if defined(PETSC_USE_COMPLEX)
6047     PetscReal    *rwork;
6048 #endif
6049 #if defined(PETSC_MISSING_LAPACK_GESVD)
6050     PetscScalar  *temp_basis,*correlation_mat;
6051 #else
6052     PetscBLASInt dummy_int=1;
6053     PetscScalar  dummy_scalar=1.;
6054 #endif
6055 
6056     /* Get index sets for faces, edges and vertices from graph */
6057     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6058     /* print some info */
6059     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6060       PetscInt nv;
6061 
6062       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6063       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6064       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6065       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6066       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6067       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6068       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6069       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6070       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6071     }
6072 
6073     /* free unneeded index sets */
6074     if (!pcbddc->use_vertices) {
6075       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6076     }
6077     if (!pcbddc->use_edges) {
6078       for (i=0;i<n_ISForEdges;i++) {
6079         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6080       }
6081       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6082       n_ISForEdges = 0;
6083     }
6084     if (!pcbddc->use_faces) {
6085       for (i=0;i<n_ISForFaces;i++) {
6086         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6087       }
6088       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6089       n_ISForFaces = 0;
6090     }
6091 
6092     /* check if near null space is attached to global mat */
6093     if (pcbddc->use_nnsp) {
6094       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6095     } else nearnullsp = NULL;
6096 
6097     if (nearnullsp) {
6098       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6099       /* remove any stored info */
6100       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6101       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6102       /* store information for BDDC solver reuse */
6103       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6104       pcbddc->onearnullspace = nearnullsp;
6105       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6106       for (i=0;i<nnsp_size;i++) {
6107         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6108       }
6109     } else { /* if near null space is not provided BDDC uses constants by default */
6110       nnsp_size = 0;
6111       nnsp_has_cnst = PETSC_TRUE;
6112     }
6113     /* get max number of constraints on a single cc */
6114     max_constraints = nnsp_size;
6115     if (nnsp_has_cnst) max_constraints++;
6116 
6117     /*
6118          Evaluate maximum storage size needed by the procedure
6119          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6120          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6121          There can be multiple constraints per connected component
6122                                                                                                                                                            */
6123     n_vertices = 0;
6124     if (ISForVertices) {
6125       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6126     }
6127     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6128     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6129 
6130     total_counts = n_ISForFaces+n_ISForEdges;
6131     total_counts *= max_constraints;
6132     total_counts += n_vertices;
6133     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6134 
6135     total_counts = 0;
6136     max_size_of_constraint = 0;
6137     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6138       IS used_is;
6139       if (i<n_ISForEdges) {
6140         used_is = ISForEdges[i];
6141       } else {
6142         used_is = ISForFaces[i-n_ISForEdges];
6143       }
6144       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6145       total_counts += j;
6146       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6147     }
6148     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);
6149 
6150     /* get local part of global near null space vectors */
6151     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6152     for (k=0;k<nnsp_size;k++) {
6153       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6154       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6155       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6156     }
6157 
6158     /* whether or not to skip lapack calls */
6159     skip_lapack = PETSC_TRUE;
6160     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6161 
6162     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6163     if (!skip_lapack) {
6164       PetscScalar temp_work;
6165 
6166 #if defined(PETSC_MISSING_LAPACK_GESVD)
6167       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6168       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6169       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6170       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6171 #if defined(PETSC_USE_COMPLEX)
6172       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6173 #endif
6174       /* now we evaluate the optimal workspace using query with lwork=-1 */
6175       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6176       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6177       lwork = -1;
6178       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6179 #if !defined(PETSC_USE_COMPLEX)
6180       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6181 #else
6182       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6183 #endif
6184       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6185       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6186 #else /* on missing GESVD */
6187       /* SVD */
6188       PetscInt max_n,min_n;
6189       max_n = max_size_of_constraint;
6190       min_n = max_constraints;
6191       if (max_size_of_constraint < max_constraints) {
6192         min_n = max_size_of_constraint;
6193         max_n = max_constraints;
6194       }
6195       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6196 #if defined(PETSC_USE_COMPLEX)
6197       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6198 #endif
6199       /* now we evaluate the optimal workspace using query with lwork=-1 */
6200       lwork = -1;
6201       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6202       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6203       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6204       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6205 #if !defined(PETSC_USE_COMPLEX)
6206       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));
6207 #else
6208       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));
6209 #endif
6210       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6211       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6212 #endif /* on missing GESVD */
6213       /* Allocate optimal workspace */
6214       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6215       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6216     }
6217     /* Now we can loop on constraining sets */
6218     total_counts = 0;
6219     constraints_idxs_ptr[0] = 0;
6220     constraints_data_ptr[0] = 0;
6221     /* vertices */
6222     if (n_vertices) {
6223       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6224       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6225       for (i=0;i<n_vertices;i++) {
6226         constraints_n[total_counts] = 1;
6227         constraints_data[total_counts] = 1.0;
6228         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6229         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6230         total_counts++;
6231       }
6232       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6233       n_vertices = total_counts;
6234     }
6235 
6236     /* edges and faces */
6237     total_counts_cc = total_counts;
6238     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6239       IS        used_is;
6240       PetscBool idxs_copied = PETSC_FALSE;
6241 
6242       if (ncc<n_ISForEdges) {
6243         used_is = ISForEdges[ncc];
6244         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6245       } else {
6246         used_is = ISForFaces[ncc-n_ISForEdges];
6247         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6248       }
6249       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6250 
6251       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6252       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6253       /* change of basis should not be performed on local periodic nodes */
6254       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6255       if (nnsp_has_cnst) {
6256         PetscScalar quad_value;
6257 
6258         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6259         idxs_copied = PETSC_TRUE;
6260 
6261         if (!pcbddc->use_nnsp_true) {
6262           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6263         } else {
6264           quad_value = 1.0;
6265         }
6266         for (j=0;j<size_of_constraint;j++) {
6267           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6268         }
6269         temp_constraints++;
6270         total_counts++;
6271       }
6272       for (k=0;k<nnsp_size;k++) {
6273         PetscReal real_value;
6274         PetscScalar *ptr_to_data;
6275 
6276         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6277         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6278         for (j=0;j<size_of_constraint;j++) {
6279           ptr_to_data[j] = array[is_indices[j]];
6280         }
6281         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6282         /* check if array is null on the connected component */
6283         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6284         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6285         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6286           temp_constraints++;
6287           total_counts++;
6288           if (!idxs_copied) {
6289             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6290             idxs_copied = PETSC_TRUE;
6291           }
6292         }
6293       }
6294       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6295       valid_constraints = temp_constraints;
6296       if (!pcbddc->use_nnsp_true && temp_constraints) {
6297         if (temp_constraints == 1) { /* just normalize the constraint */
6298           PetscScalar norm,*ptr_to_data;
6299 
6300           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6301           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6302           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6303           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6304           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6305         } else { /* perform SVD */
6306           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6307 
6308 #if defined(PETSC_MISSING_LAPACK_GESVD)
6309           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6310              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6311              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6312                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6313                 from that computed using LAPACKgesvd
6314              -> This is due to a different computation of eigenvectors in LAPACKheev
6315              -> The quality of the POD-computed basis will be the same */
6316           ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6317           /* Store upper triangular part of correlation matrix */
6318           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6319           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6320           for (j=0;j<temp_constraints;j++) {
6321             for (k=0;k<j+1;k++) {
6322               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));
6323             }
6324           }
6325           /* compute eigenvalues and eigenvectors of correlation matrix */
6326           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6327           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6328 #if !defined(PETSC_USE_COMPLEX)
6329           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6330 #else
6331           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6332 #endif
6333           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6334           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6335           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6336           j = 0;
6337           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6338           total_counts = total_counts-j;
6339           valid_constraints = temp_constraints-j;
6340           /* scale and copy POD basis into used quadrature memory */
6341           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6342           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6343           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6344           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6345           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6346           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6347           if (j<temp_constraints) {
6348             PetscInt ii;
6349             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6350             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6351             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));
6352             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6353             for (k=0;k<temp_constraints-j;k++) {
6354               for (ii=0;ii<size_of_constraint;ii++) {
6355                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6356               }
6357             }
6358           }
6359 #else  /* on missing GESVD */
6360           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6361           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6362           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6363           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6364 #if !defined(PETSC_USE_COMPLEX)
6365           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));
6366 #else
6367           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));
6368 #endif
6369           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6370           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6371           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6372           k = temp_constraints;
6373           if (k > size_of_constraint) k = size_of_constraint;
6374           j = 0;
6375           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6376           valid_constraints = k-j;
6377           total_counts = total_counts-temp_constraints+valid_constraints;
6378 #endif /* on missing GESVD */
6379         }
6380       }
6381       /* update pointers information */
6382       if (valid_constraints) {
6383         constraints_n[total_counts_cc] = valid_constraints;
6384         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6385         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6386         /* set change_of_basis flag */
6387         if (boolforchange) {
6388           PetscBTSet(change_basis,total_counts_cc);
6389         }
6390         total_counts_cc++;
6391       }
6392     }
6393     /* free workspace */
6394     if (!skip_lapack) {
6395       ierr = PetscFree(work);CHKERRQ(ierr);
6396 #if defined(PETSC_USE_COMPLEX)
6397       ierr = PetscFree(rwork);CHKERRQ(ierr);
6398 #endif
6399       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6400 #if defined(PETSC_MISSING_LAPACK_GESVD)
6401       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6402       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6403 #endif
6404     }
6405     for (k=0;k<nnsp_size;k++) {
6406       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6407     }
6408     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6409     /* free index sets of faces, edges and vertices */
6410     for (i=0;i<n_ISForFaces;i++) {
6411       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6412     }
6413     if (n_ISForFaces) {
6414       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6415     }
6416     for (i=0;i<n_ISForEdges;i++) {
6417       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6418     }
6419     if (n_ISForEdges) {
6420       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6421     }
6422     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6423   } else {
6424     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6425 
6426     total_counts = 0;
6427     n_vertices = 0;
6428     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6429       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6430     }
6431     max_constraints = 0;
6432     total_counts_cc = 0;
6433     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6434       total_counts += pcbddc->adaptive_constraints_n[i];
6435       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6436       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6437     }
6438     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6439     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6440     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6441     constraints_data = pcbddc->adaptive_constraints_data;
6442     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6443     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6444     total_counts_cc = 0;
6445     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6446       if (pcbddc->adaptive_constraints_n[i]) {
6447         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6448       }
6449     }
6450 
6451     max_size_of_constraint = 0;
6452     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]);
6453     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6454     /* Change of basis */
6455     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6456     if (pcbddc->use_change_of_basis) {
6457       for (i=0;i<sub_schurs->n_subs;i++) {
6458         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6459           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6460         }
6461       }
6462     }
6463   }
6464   pcbddc->local_primal_size = total_counts;
6465   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6466 
6467   /* map constraints_idxs in boundary numbering */
6468   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6469   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);
6470 
6471   /* Create constraint matrix */
6472   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6473   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6474   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6475 
6476   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6477   /* determine if a QR strategy is needed for change of basis */
6478   qr_needed = pcbddc->use_qr_single;
6479   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6480   total_primal_vertices=0;
6481   pcbddc->local_primal_size_cc = 0;
6482   for (i=0;i<total_counts_cc;i++) {
6483     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6484     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6485       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6486       pcbddc->local_primal_size_cc += 1;
6487     } else if (PetscBTLookup(change_basis,i)) {
6488       for (k=0;k<constraints_n[i];k++) {
6489         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6490       }
6491       pcbddc->local_primal_size_cc += constraints_n[i];
6492       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6493         PetscBTSet(qr_needed_idx,i);
6494         qr_needed = PETSC_TRUE;
6495       }
6496     } else {
6497       pcbddc->local_primal_size_cc += 1;
6498     }
6499   }
6500   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6501   pcbddc->n_vertices = total_primal_vertices;
6502   /* permute indices in order to have a sorted set of vertices */
6503   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6504   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);
6505   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6506   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6507 
6508   /* nonzero structure of constraint matrix */
6509   /* and get reference dof for local constraints */
6510   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6511   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6512 
6513   j = total_primal_vertices;
6514   total_counts = total_primal_vertices;
6515   cum = total_primal_vertices;
6516   for (i=n_vertices;i<total_counts_cc;i++) {
6517     if (!PetscBTLookup(change_basis,i)) {
6518       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6519       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6520       cum++;
6521       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6522       for (k=0;k<constraints_n[i];k++) {
6523         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6524         nnz[j+k] = size_of_constraint;
6525       }
6526       j += constraints_n[i];
6527     }
6528   }
6529   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6530   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6531   ierr = PetscFree(nnz);CHKERRQ(ierr);
6532 
6533   /* set values in constraint matrix */
6534   for (i=0;i<total_primal_vertices;i++) {
6535     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6536   }
6537   total_counts = total_primal_vertices;
6538   for (i=n_vertices;i<total_counts_cc;i++) {
6539     if (!PetscBTLookup(change_basis,i)) {
6540       PetscInt *cols;
6541 
6542       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6543       cols = constraints_idxs+constraints_idxs_ptr[i];
6544       for (k=0;k<constraints_n[i];k++) {
6545         PetscInt    row = total_counts+k;
6546         PetscScalar *vals;
6547 
6548         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6549         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6550       }
6551       total_counts += constraints_n[i];
6552     }
6553   }
6554   /* assembling */
6555   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6556   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6557   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6558 
6559   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6560   if (pcbddc->use_change_of_basis) {
6561     /* dual and primal dofs on a single cc */
6562     PetscInt     dual_dofs,primal_dofs;
6563     /* working stuff for GEQRF */
6564     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6565     PetscBLASInt lqr_work;
6566     /* working stuff for UNGQR */
6567     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6568     PetscBLASInt lgqr_work;
6569     /* working stuff for TRTRS */
6570     PetscScalar  *trs_rhs = NULL;
6571     PetscBLASInt Blas_NRHS;
6572     /* pointers for values insertion into change of basis matrix */
6573     PetscInt     *start_rows,*start_cols;
6574     PetscScalar  *start_vals;
6575     /* working stuff for values insertion */
6576     PetscBT      is_primal;
6577     PetscInt     *aux_primal_numbering_B;
6578     /* matrix sizes */
6579     PetscInt     global_size,local_size;
6580     /* temporary change of basis */
6581     Mat          localChangeOfBasisMatrix;
6582     /* extra space for debugging */
6583     PetscScalar  *dbg_work = NULL;
6584 
6585     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6586     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6587     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6588     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6589     /* nonzeros for local mat */
6590     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6591     if (!pcbddc->benign_change || pcbddc->fake_change) {
6592       for (i=0;i<pcis->n;i++) nnz[i]=1;
6593     } else {
6594       const PetscInt *ii;
6595       PetscInt       n;
6596       PetscBool      flg_row;
6597       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6598       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6599       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6600     }
6601     for (i=n_vertices;i<total_counts_cc;i++) {
6602       if (PetscBTLookup(change_basis,i)) {
6603         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6604         if (PetscBTLookup(qr_needed_idx,i)) {
6605           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6606         } else {
6607           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6608           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6609         }
6610       }
6611     }
6612     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6613     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6614     ierr = PetscFree(nnz);CHKERRQ(ierr);
6615     /* Set interior change in the matrix */
6616     if (!pcbddc->benign_change || pcbddc->fake_change) {
6617       for (i=0;i<pcis->n;i++) {
6618         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6619       }
6620     } else {
6621       const PetscInt *ii,*jj;
6622       PetscScalar    *aa;
6623       PetscInt       n;
6624       PetscBool      flg_row;
6625       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6626       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6627       for (i=0;i<n;i++) {
6628         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6629       }
6630       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6631       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6632     }
6633 
6634     if (pcbddc->dbg_flag) {
6635       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6636       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6637     }
6638 
6639 
6640     /* Now we loop on the constraints which need a change of basis */
6641     /*
6642        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6643        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6644 
6645        Basic blocks of change of basis matrix T computed by
6646 
6647           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6648 
6649             | 1        0   ...        0         s_1/S |
6650             | 0        1   ...        0         s_2/S |
6651             |              ...                        |
6652             | 0        ...            1     s_{n-1}/S |
6653             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6654 
6655             with S = \sum_{i=1}^n s_i^2
6656             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6657                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6658 
6659           - QR decomposition of constraints otherwise
6660     */
6661     if (qr_needed && max_size_of_constraint) {
6662       /* space to store Q */
6663       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6664       /* array to store scaling factors for reflectors */
6665       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6666       /* first we issue queries for optimal work */
6667       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6668       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6669       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6670       lqr_work = -1;
6671       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6672       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6673       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6674       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6675       lgqr_work = -1;
6676       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6677       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6678       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6679       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6680       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6681       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6682       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6683       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6684       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6685       /* array to store rhs and solution of triangular solver */
6686       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6687       /* allocating workspace for check */
6688       if (pcbddc->dbg_flag) {
6689         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6690       }
6691     }
6692     /* array to store whether a node is primal or not */
6693     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6694     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6695     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6696     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);
6697     for (i=0;i<total_primal_vertices;i++) {
6698       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6699     }
6700     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6701 
6702     /* loop on constraints and see whether or not they need a change of basis and compute it */
6703     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6704       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6705       if (PetscBTLookup(change_basis,total_counts)) {
6706         /* get constraint info */
6707         primal_dofs = constraints_n[total_counts];
6708         dual_dofs = size_of_constraint-primal_dofs;
6709 
6710         if (pcbddc->dbg_flag) {
6711           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);
6712         }
6713 
6714         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6715 
6716           /* copy quadrature constraints for change of basis check */
6717           if (pcbddc->dbg_flag) {
6718             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6719           }
6720           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6721           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6722 
6723           /* compute QR decomposition of constraints */
6724           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6725           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6726           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6727           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6728           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6729           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6730           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6731 
6732           /* explictly compute R^-T */
6733           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6734           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6735           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6736           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6737           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6738           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6739           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6740           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6741           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6742           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6743 
6744           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6745           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6746           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6747           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6748           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6749           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6750           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6751           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6752           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6753 
6754           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6755              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6756              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6757           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6758           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6759           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6760           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6761           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6762           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6763           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6764           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));
6765           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6766           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6767 
6768           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6769           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6770           /* insert cols for primal dofs */
6771           for (j=0;j<primal_dofs;j++) {
6772             start_vals = &qr_basis[j*size_of_constraint];
6773             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6774             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6775           }
6776           /* insert cols for dual dofs */
6777           for (j=0,k=0;j<dual_dofs;k++) {
6778             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6779               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6780               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6781               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6782               j++;
6783             }
6784           }
6785 
6786           /* check change of basis */
6787           if (pcbddc->dbg_flag) {
6788             PetscInt   ii,jj;
6789             PetscBool valid_qr=PETSC_TRUE;
6790             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6791             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6792             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6793             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6794             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6795             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6796             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6797             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));
6798             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6799             for (jj=0;jj<size_of_constraint;jj++) {
6800               for (ii=0;ii<primal_dofs;ii++) {
6801                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6802                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6803               }
6804             }
6805             if (!valid_qr) {
6806               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6807               for (jj=0;jj<size_of_constraint;jj++) {
6808                 for (ii=0;ii<primal_dofs;ii++) {
6809                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6810                     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);
6811                   }
6812                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6813                     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);
6814                   }
6815                 }
6816               }
6817             } else {
6818               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6819             }
6820           }
6821         } else { /* simple transformation block */
6822           PetscInt    row,col;
6823           PetscScalar val,norm;
6824 
6825           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6826           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6827           for (j=0;j<size_of_constraint;j++) {
6828             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6829             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6830             if (!PetscBTLookup(is_primal,row_B)) {
6831               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6832               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6833               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6834             } else {
6835               for (k=0;k<size_of_constraint;k++) {
6836                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6837                 if (row != col) {
6838                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6839                 } else {
6840                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6841                 }
6842                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6843               }
6844             }
6845           }
6846           if (pcbddc->dbg_flag) {
6847             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6848           }
6849         }
6850       } else {
6851         if (pcbddc->dbg_flag) {
6852           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6853         }
6854       }
6855     }
6856 
6857     /* free workspace */
6858     if (qr_needed) {
6859       if (pcbddc->dbg_flag) {
6860         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6861       }
6862       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6863       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6864       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6865       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6866       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6867     }
6868     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6869     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6870     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6871 
6872     /* assembling of global change of variable */
6873     if (!pcbddc->fake_change) {
6874       Mat      tmat;
6875       PetscInt bs;
6876 
6877       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6878       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6879       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6880       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6881       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6882       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6883       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6884       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6885       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6886       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6887       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6888       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6889       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6890       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6891       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6892       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6893       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6894       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6895       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6896       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6897 
6898       /* check */
6899       if (pcbddc->dbg_flag) {
6900         PetscReal error;
6901         Vec       x,x_change;
6902 
6903         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6904         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6905         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6906         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6907         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6908         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6909         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6910         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6911         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6912         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6913         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6914         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6915         if (error > PETSC_SMALL) {
6916           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6917         }
6918         ierr = VecDestroy(&x);CHKERRQ(ierr);
6919         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6920       }
6921       /* adapt sub_schurs computed (if any) */
6922       if (pcbddc->use_deluxe_scaling) {
6923         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6924 
6925         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");
6926         if (sub_schurs && sub_schurs->S_Ej_all) {
6927           Mat                    S_new,tmat;
6928           IS                     is_all_N,is_V_Sall = NULL;
6929 
6930           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6931           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6932           if (pcbddc->deluxe_zerorows) {
6933             ISLocalToGlobalMapping NtoSall;
6934             IS                     is_V;
6935             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6936             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6937             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6938             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6939             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6940           }
6941           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6942           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6943           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6944           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6945           if (pcbddc->deluxe_zerorows) {
6946             const PetscScalar *array;
6947             const PetscInt    *idxs_V,*idxs_all;
6948             PetscInt          i,n_V;
6949 
6950             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6951             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6952             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6953             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6954             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6955             for (i=0;i<n_V;i++) {
6956               PetscScalar val;
6957               PetscInt    idx;
6958 
6959               idx = idxs_V[i];
6960               val = array[idxs_all[idxs_V[i]]];
6961               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6962             }
6963             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6964             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6965             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6966             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6967             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6968           }
6969           sub_schurs->S_Ej_all = S_new;
6970           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6971           if (sub_schurs->sum_S_Ej_all) {
6972             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6973             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6974             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6975             if (pcbddc->deluxe_zerorows) {
6976               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6977             }
6978             sub_schurs->sum_S_Ej_all = S_new;
6979             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6980           }
6981           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6982           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6983         }
6984         /* destroy any change of basis context in sub_schurs */
6985         if (sub_schurs && sub_schurs->change) {
6986           PetscInt i;
6987 
6988           for (i=0;i<sub_schurs->n_subs;i++) {
6989             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6990           }
6991           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6992         }
6993       }
6994       if (pcbddc->switch_static) { /* need to save the local change */
6995         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6996       } else {
6997         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6998       }
6999       /* determine if any process has changed the pressures locally */
7000       pcbddc->change_interior = pcbddc->benign_have_null;
7001     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7002       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7003       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7004       pcbddc->use_qr_single = qr_needed;
7005     }
7006   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7007     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7008       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7009       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7010     } else {
7011       Mat benign_global = NULL;
7012       if (pcbddc->benign_have_null) {
7013         Mat M;
7014 
7015         pcbddc->change_interior = PETSC_TRUE;
7016         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7017         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7018         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7019         if (pcbddc->benign_change) {
7020           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7021           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7022         } else {
7023           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7024           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7025         }
7026         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7027         ierr = MatDestroy(&M);CHKERRQ(ierr);
7028         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7029         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7030       }
7031       if (pcbddc->user_ChangeOfBasisMatrix) {
7032         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7033         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7034       } else if (pcbddc->benign_have_null) {
7035         pcbddc->ChangeOfBasisMatrix = benign_global;
7036       }
7037     }
7038     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7039       IS             is_global;
7040       const PetscInt *gidxs;
7041 
7042       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7043       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7044       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7045       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7046       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7047     }
7048   }
7049   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7050     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7051   }
7052 
7053   if (!pcbddc->fake_change) {
7054     /* add pressure dofs to set of primal nodes for numbering purposes */
7055     for (i=0;i<pcbddc->benign_n;i++) {
7056       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7057       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7058       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7059       pcbddc->local_primal_size_cc++;
7060       pcbddc->local_primal_size++;
7061     }
7062 
7063     /* check if a new primal space has been introduced (also take into account benign trick) */
7064     pcbddc->new_primal_space_local = PETSC_TRUE;
7065     if (olocal_primal_size == pcbddc->local_primal_size) {
7066       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7067       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7068       if (!pcbddc->new_primal_space_local) {
7069         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7070         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7071       }
7072     }
7073     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7074     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7075   }
7076   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7077 
7078   /* flush dbg viewer */
7079   if (pcbddc->dbg_flag) {
7080     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7081   }
7082 
7083   /* free workspace */
7084   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7085   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7086   if (!pcbddc->adaptive_selection) {
7087     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7088     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7089   } else {
7090     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7091                       pcbddc->adaptive_constraints_idxs_ptr,
7092                       pcbddc->adaptive_constraints_data_ptr,
7093                       pcbddc->adaptive_constraints_idxs,
7094                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7095     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7096     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7097   }
7098   PetscFunctionReturn(0);
7099 }
7100 /* #undef PETSC_MISSING_LAPACK_GESVD */
7101 
7102 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7103 {
7104   ISLocalToGlobalMapping map;
7105   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7106   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7107   PetscInt               i,N;
7108   PetscBool              rcsr = PETSC_FALSE;
7109   PetscErrorCode         ierr;
7110 
7111   PetscFunctionBegin;
7112   if (pcbddc->recompute_topography) {
7113     pcbddc->graphanalyzed = PETSC_FALSE;
7114     /* Reset previously computed graph */
7115     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7116     /* Init local Graph struct */
7117     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7118     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7119     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7120 
7121     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7122       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7123     }
7124     /* Check validity of the csr graph passed in by the user */
7125     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);
7126 
7127     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7128     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7129       PetscInt  *xadj,*adjncy;
7130       PetscInt  nvtxs;
7131       PetscBool flg_row=PETSC_FALSE;
7132 
7133       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7134       if (flg_row) {
7135         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7136         pcbddc->computed_rowadj = PETSC_TRUE;
7137       }
7138       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7139       rcsr = PETSC_TRUE;
7140     }
7141     if (pcbddc->dbg_flag) {
7142       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7143     }
7144 
7145     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7146       PetscReal    *lcoords;
7147       PetscInt     n;
7148       MPI_Datatype dimrealtype;
7149 
7150       /* TODO: support for blocked */
7151       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);
7152       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7153       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7154       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7155       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7156       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7157       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7158       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7159       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7160 
7161       pcbddc->mat_graph->coords = lcoords;
7162       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7163       pcbddc->mat_graph->cnloc  = n;
7164     }
7165     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);
7166     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7167 
7168     /* Setup of Graph */
7169     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7170     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7171 
7172     /* attach info on disconnected subdomains if present */
7173     if (pcbddc->n_local_subs) {
7174       PetscInt *local_subs,n,totn;
7175 
7176       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7177       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7178       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7179       for (i=0;i<pcbddc->n_local_subs;i++) {
7180         const PetscInt *idxs;
7181         PetscInt       nl,j;
7182 
7183         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7184         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7185         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7186         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7187       }
7188       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7189       pcbddc->mat_graph->n_local_subs = totn + 1;
7190       pcbddc->mat_graph->local_subs = local_subs;
7191     }
7192   }
7193 
7194   if (!pcbddc->graphanalyzed) {
7195     /* Graph's connected components analysis */
7196     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7197     pcbddc->graphanalyzed = PETSC_TRUE;
7198     pcbddc->corner_selected = pcbddc->corner_selection;
7199   }
7200   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7201   PetscFunctionReturn(0);
7202 }
7203 
7204 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7205 {
7206   PetscInt       i,j,n;
7207   PetscScalar    *alphas;
7208   PetscReal      norm,*onorms;
7209   PetscErrorCode ierr;
7210 
7211   PetscFunctionBegin;
7212   n = *nio;
7213   if (!n) PetscFunctionReturn(0);
7214   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7215   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7216   if (norm < PETSC_SMALL) {
7217     onorms[0] = 0.0;
7218     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7219   } else {
7220     onorms[0] = norm;
7221   }
7222 
7223   for (i=1;i<n;i++) {
7224     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7225     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7226     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7227     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7228     if (norm < PETSC_SMALL) {
7229       onorms[i] = 0.0;
7230       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7231     } else {
7232       onorms[i] = norm;
7233     }
7234   }
7235   /* push nonzero vectors at the beginning */
7236   for (i=0;i<n;i++) {
7237     if (onorms[i] == 0.0) {
7238       for (j=i+1;j<n;j++) {
7239         if (onorms[j] != 0.0) {
7240           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7241           onorms[j] = 0.0;
7242         }
7243       }
7244     }
7245   }
7246   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7247   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7248   PetscFunctionReturn(0);
7249 }
7250 
7251 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7252 {
7253   Mat            A;
7254   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7255   PetscMPIInt    size,rank,color;
7256   PetscInt       *xadj,*adjncy;
7257   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7258   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7259   PetscInt       void_procs,*procs_candidates = NULL;
7260   PetscInt       xadj_count,*count;
7261   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7262   PetscSubcomm   psubcomm;
7263   MPI_Comm       subcomm;
7264   PetscErrorCode ierr;
7265 
7266   PetscFunctionBegin;
7267   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7268   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7269   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);
7270   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7271   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7272   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7273 
7274   if (have_void) *have_void = PETSC_FALSE;
7275   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7276   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7277   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7278   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7279   im_active = !!n;
7280   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7281   void_procs = size - active_procs;
7282   /* get ranks of of non-active processes in mat communicator */
7283   if (void_procs) {
7284     PetscInt ncand;
7285 
7286     if (have_void) *have_void = PETSC_TRUE;
7287     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7288     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7289     for (i=0,ncand=0;i<size;i++) {
7290       if (!procs_candidates[i]) {
7291         procs_candidates[ncand++] = i;
7292       }
7293     }
7294     /* force n_subdomains to be not greater that the number of non-active processes */
7295     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7296   }
7297 
7298   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7299      number of subdomains requested 1 -> send to master or first candidate in voids  */
7300   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7301   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7302     PetscInt issize,isidx,dest;
7303     if (*n_subdomains == 1) dest = 0;
7304     else dest = rank;
7305     if (im_active) {
7306       issize = 1;
7307       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7308         isidx = procs_candidates[dest];
7309       } else {
7310         isidx = dest;
7311       }
7312     } else {
7313       issize = 0;
7314       isidx = -1;
7315     }
7316     if (*n_subdomains != 1) *n_subdomains = active_procs;
7317     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7318     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7319     PetscFunctionReturn(0);
7320   }
7321   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7322   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7323   threshold = PetscMax(threshold,2);
7324 
7325   /* Get info on mapping */
7326   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7327 
7328   /* build local CSR graph of subdomains' connectivity */
7329   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7330   xadj[0] = 0;
7331   xadj[1] = PetscMax(n_neighs-1,0);
7332   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7333   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7334   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7335   for (i=1;i<n_neighs;i++)
7336     for (j=0;j<n_shared[i];j++)
7337       count[shared[i][j]] += 1;
7338 
7339   xadj_count = 0;
7340   for (i=1;i<n_neighs;i++) {
7341     for (j=0;j<n_shared[i];j++) {
7342       if (count[shared[i][j]] < threshold) {
7343         adjncy[xadj_count] = neighs[i];
7344         adjncy_wgt[xadj_count] = n_shared[i];
7345         xadj_count++;
7346         break;
7347       }
7348     }
7349   }
7350   xadj[1] = xadj_count;
7351   ierr = PetscFree(count);CHKERRQ(ierr);
7352   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7353   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7354 
7355   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7356 
7357   /* Restrict work on active processes only */
7358   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7359   if (void_procs) {
7360     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7361     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7362     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7363     subcomm = PetscSubcommChild(psubcomm);
7364   } else {
7365     psubcomm = NULL;
7366     subcomm = PetscObjectComm((PetscObject)mat);
7367   }
7368 
7369   v_wgt = NULL;
7370   if (!color) {
7371     ierr = PetscFree(xadj);CHKERRQ(ierr);
7372     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7373     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7374   } else {
7375     Mat             subdomain_adj;
7376     IS              new_ranks,new_ranks_contig;
7377     MatPartitioning partitioner;
7378     PetscInt        rstart=0,rend=0;
7379     PetscInt        *is_indices,*oldranks;
7380     PetscMPIInt     size;
7381     PetscBool       aggregate;
7382 
7383     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7384     if (void_procs) {
7385       PetscInt prank = rank;
7386       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7387       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7388       for (i=0;i<xadj[1];i++) {
7389         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7390       }
7391       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7392     } else {
7393       oldranks = NULL;
7394     }
7395     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7396     if (aggregate) { /* TODO: all this part could be made more efficient */
7397       PetscInt    lrows,row,ncols,*cols;
7398       PetscMPIInt nrank;
7399       PetscScalar *vals;
7400 
7401       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7402       lrows = 0;
7403       if (nrank<redprocs) {
7404         lrows = size/redprocs;
7405         if (nrank<size%redprocs) lrows++;
7406       }
7407       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7408       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7409       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7410       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7411       row = nrank;
7412       ncols = xadj[1]-xadj[0];
7413       cols = adjncy;
7414       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7415       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7416       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7417       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7418       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7419       ierr = PetscFree(xadj);CHKERRQ(ierr);
7420       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7421       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7422       ierr = PetscFree(vals);CHKERRQ(ierr);
7423       if (use_vwgt) {
7424         Vec               v;
7425         const PetscScalar *array;
7426         PetscInt          nl;
7427 
7428         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7429         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7430         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7431         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7432         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7433         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7434         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7435         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7436         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7437         ierr = VecDestroy(&v);CHKERRQ(ierr);
7438       }
7439     } else {
7440       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7441       if (use_vwgt) {
7442         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7443         v_wgt[0] = n;
7444       }
7445     }
7446     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7447 
7448     /* Partition */
7449     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7450 #if defined(PETSC_HAVE_PTSCOTCH)
7451     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7452 #elif defined(PETSC_HAVE_PARMETIS)
7453     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7454 #else
7455     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7456 #endif
7457     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7458     if (v_wgt) {
7459       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7460     }
7461     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7462     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7463     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7464     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7465     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7466 
7467     /* renumber new_ranks to avoid "holes" in new set of processors */
7468     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7469     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7470     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7471     if (!aggregate) {
7472       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7473 #if defined(PETSC_USE_DEBUG)
7474         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7475 #endif
7476         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7477       } else if (oldranks) {
7478         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7479       } else {
7480         ranks_send_to_idx[0] = is_indices[0];
7481       }
7482     } else {
7483       PetscInt    idx = 0;
7484       PetscMPIInt tag;
7485       MPI_Request *reqs;
7486 
7487       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7488       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7489       for (i=rstart;i<rend;i++) {
7490         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7491       }
7492       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7493       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7494       ierr = PetscFree(reqs);CHKERRQ(ierr);
7495       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7496 #if defined(PETSC_USE_DEBUG)
7497         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7498 #endif
7499         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7500       } else if (oldranks) {
7501         ranks_send_to_idx[0] = oldranks[idx];
7502       } else {
7503         ranks_send_to_idx[0] = idx;
7504       }
7505     }
7506     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7507     /* clean up */
7508     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7509     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7510     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7511     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7512   }
7513   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7514   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7515 
7516   /* assemble parallel IS for sends */
7517   i = 1;
7518   if (!color) i=0;
7519   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7520   PetscFunctionReturn(0);
7521 }
7522 
7523 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7524 
7525 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[])
7526 {
7527   Mat                    local_mat;
7528   IS                     is_sends_internal;
7529   PetscInt               rows,cols,new_local_rows;
7530   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7531   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7532   ISLocalToGlobalMapping l2gmap;
7533   PetscInt*              l2gmap_indices;
7534   const PetscInt*        is_indices;
7535   MatType                new_local_type;
7536   /* buffers */
7537   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7538   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7539   PetscInt               *recv_buffer_idxs_local;
7540   PetscScalar            *ptr_vals,*recv_buffer_vals;
7541   const PetscScalar      *send_buffer_vals;
7542   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7543   /* MPI */
7544   MPI_Comm               comm,comm_n;
7545   PetscSubcomm           subcomm;
7546   PetscMPIInt            n_sends,n_recvs,size;
7547   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7548   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7549   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7550   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7551   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7552   PetscErrorCode         ierr;
7553 
7554   PetscFunctionBegin;
7555   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7556   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7557   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);
7558   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7559   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7560   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7561   PetscValidLogicalCollectiveBool(mat,reuse,6);
7562   PetscValidLogicalCollectiveInt(mat,nis,8);
7563   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7564   if (nvecs) {
7565     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7566     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7567   }
7568   /* further checks */
7569   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7570   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7571   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7572   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7573   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7574   if (reuse && *mat_n) {
7575     PetscInt mrows,mcols,mnrows,mncols;
7576     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7577     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7578     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7579     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7580     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7581     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7582     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7583   }
7584   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7585   PetscValidLogicalCollectiveInt(mat,bs,0);
7586 
7587   /* prepare IS for sending if not provided */
7588   if (!is_sends) {
7589     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7590     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7591   } else {
7592     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7593     is_sends_internal = is_sends;
7594   }
7595 
7596   /* get comm */
7597   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7598 
7599   /* compute number of sends */
7600   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7601   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7602 
7603   /* compute number of receives */
7604   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7605   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7606   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7607   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7608   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7609   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7610   ierr = PetscFree(iflags);CHKERRQ(ierr);
7611 
7612   /* restrict comm if requested */
7613   subcomm = 0;
7614   destroy_mat = PETSC_FALSE;
7615   if (restrict_comm) {
7616     PetscMPIInt color,subcommsize;
7617 
7618     color = 0;
7619     if (restrict_full) {
7620       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7621     } else {
7622       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7623     }
7624     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7625     subcommsize = size - subcommsize;
7626     /* check if reuse has been requested */
7627     if (reuse) {
7628       if (*mat_n) {
7629         PetscMPIInt subcommsize2;
7630         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7631         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7632         comm_n = PetscObjectComm((PetscObject)*mat_n);
7633       } else {
7634         comm_n = PETSC_COMM_SELF;
7635       }
7636     } else { /* MAT_INITIAL_MATRIX */
7637       PetscMPIInt rank;
7638 
7639       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7640       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7641       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7642       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7643       comm_n = PetscSubcommChild(subcomm);
7644     }
7645     /* flag to destroy *mat_n if not significative */
7646     if (color) destroy_mat = PETSC_TRUE;
7647   } else {
7648     comm_n = comm;
7649   }
7650 
7651   /* prepare send/receive buffers */
7652   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7653   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7654   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7655   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7656   if (nis) {
7657     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7658   }
7659 
7660   /* Get data from local matrices */
7661   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7662     /* TODO: See below some guidelines on how to prepare the local buffers */
7663     /*
7664        send_buffer_vals should contain the raw values of the local matrix
7665        send_buffer_idxs should contain:
7666        - MatType_PRIVATE type
7667        - PetscInt        size_of_l2gmap
7668        - PetscInt        global_row_indices[size_of_l2gmap]
7669        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7670     */
7671   else {
7672     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7673     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7674     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7675     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7676     send_buffer_idxs[1] = i;
7677     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7678     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7679     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7680     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7681     for (i=0;i<n_sends;i++) {
7682       ilengths_vals[is_indices[i]] = len*len;
7683       ilengths_idxs[is_indices[i]] = len+2;
7684     }
7685   }
7686   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7687   /* additional is (if any) */
7688   if (nis) {
7689     PetscMPIInt psum;
7690     PetscInt j;
7691     for (j=0,psum=0;j<nis;j++) {
7692       PetscInt plen;
7693       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7694       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7695       psum += len+1; /* indices + lenght */
7696     }
7697     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7698     for (j=0,psum=0;j<nis;j++) {
7699       PetscInt plen;
7700       const PetscInt *is_array_idxs;
7701       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7702       send_buffer_idxs_is[psum] = plen;
7703       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7704       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7705       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7706       psum += plen+1; /* indices + lenght */
7707     }
7708     for (i=0;i<n_sends;i++) {
7709       ilengths_idxs_is[is_indices[i]] = psum;
7710     }
7711     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7712   }
7713   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7714 
7715   buf_size_idxs = 0;
7716   buf_size_vals = 0;
7717   buf_size_idxs_is = 0;
7718   buf_size_vecs = 0;
7719   for (i=0;i<n_recvs;i++) {
7720     buf_size_idxs += (PetscInt)olengths_idxs[i];
7721     buf_size_vals += (PetscInt)olengths_vals[i];
7722     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7723     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7724   }
7725   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7726   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7727   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7728   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7729 
7730   /* get new tags for clean communications */
7731   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7732   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7733   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7734   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7735 
7736   /* allocate for requests */
7737   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7738   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7739   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7740   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7741   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7742   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7743   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7744   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7745 
7746   /* communications */
7747   ptr_idxs = recv_buffer_idxs;
7748   ptr_vals = recv_buffer_vals;
7749   ptr_idxs_is = recv_buffer_idxs_is;
7750   ptr_vecs = recv_buffer_vecs;
7751   for (i=0;i<n_recvs;i++) {
7752     source_dest = onodes[i];
7753     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7754     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7755     ptr_idxs += olengths_idxs[i];
7756     ptr_vals += olengths_vals[i];
7757     if (nis) {
7758       source_dest = onodes_is[i];
7759       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);
7760       ptr_idxs_is += olengths_idxs_is[i];
7761     }
7762     if (nvecs) {
7763       source_dest = onodes[i];
7764       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7765       ptr_vecs += olengths_idxs[i]-2;
7766     }
7767   }
7768   for (i=0;i<n_sends;i++) {
7769     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7770     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7771     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7772     if (nis) {
7773       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);
7774     }
7775     if (nvecs) {
7776       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7777       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7778     }
7779   }
7780   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7781   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7782 
7783   /* assemble new l2g map */
7784   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7785   ptr_idxs = recv_buffer_idxs;
7786   new_local_rows = 0;
7787   for (i=0;i<n_recvs;i++) {
7788     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7789     ptr_idxs += olengths_idxs[i];
7790   }
7791   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7792   ptr_idxs = recv_buffer_idxs;
7793   new_local_rows = 0;
7794   for (i=0;i<n_recvs;i++) {
7795     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7796     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7797     ptr_idxs += olengths_idxs[i];
7798   }
7799   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7800   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7801   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7802 
7803   /* infer new local matrix type from received local matrices type */
7804   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7805   /* 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) */
7806   if (n_recvs) {
7807     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7808     ptr_idxs = recv_buffer_idxs;
7809     for (i=0;i<n_recvs;i++) {
7810       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7811         new_local_type_private = MATAIJ_PRIVATE;
7812         break;
7813       }
7814       ptr_idxs += olengths_idxs[i];
7815     }
7816     switch (new_local_type_private) {
7817       case MATDENSE_PRIVATE:
7818         new_local_type = MATSEQAIJ;
7819         bs = 1;
7820         break;
7821       case MATAIJ_PRIVATE:
7822         new_local_type = MATSEQAIJ;
7823         bs = 1;
7824         break;
7825       case MATBAIJ_PRIVATE:
7826         new_local_type = MATSEQBAIJ;
7827         break;
7828       case MATSBAIJ_PRIVATE:
7829         new_local_type = MATSEQSBAIJ;
7830         break;
7831       default:
7832         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7833         break;
7834     }
7835   } else { /* by default, new_local_type is seqaij */
7836     new_local_type = MATSEQAIJ;
7837     bs = 1;
7838   }
7839 
7840   /* create MATIS object if needed */
7841   if (!reuse) {
7842     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7843     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7844   } else {
7845     /* it also destroys the local matrices */
7846     if (*mat_n) {
7847       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7848     } else { /* this is a fake object */
7849       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7850     }
7851   }
7852   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7853   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7854 
7855   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7856 
7857   /* Global to local map of received indices */
7858   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7859   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7860   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7861 
7862   /* restore attributes -> type of incoming data and its size */
7863   buf_size_idxs = 0;
7864   for (i=0;i<n_recvs;i++) {
7865     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7866     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7867     buf_size_idxs += (PetscInt)olengths_idxs[i];
7868   }
7869   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7870 
7871   /* set preallocation */
7872   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7873   if (!newisdense) {
7874     PetscInt *new_local_nnz=0;
7875 
7876     ptr_idxs = recv_buffer_idxs_local;
7877     if (n_recvs) {
7878       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7879     }
7880     for (i=0;i<n_recvs;i++) {
7881       PetscInt j;
7882       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7883         for (j=0;j<*(ptr_idxs+1);j++) {
7884           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7885         }
7886       } else {
7887         /* TODO */
7888       }
7889       ptr_idxs += olengths_idxs[i];
7890     }
7891     if (new_local_nnz) {
7892       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7893       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7894       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7895       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7896       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7897       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7898     } else {
7899       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7900     }
7901     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7902   } else {
7903     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7904   }
7905 
7906   /* set values */
7907   ptr_vals = recv_buffer_vals;
7908   ptr_idxs = recv_buffer_idxs_local;
7909   for (i=0;i<n_recvs;i++) {
7910     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7911       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7912       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7913       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7914       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7915       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7916     } else {
7917       /* TODO */
7918     }
7919     ptr_idxs += olengths_idxs[i];
7920     ptr_vals += olengths_vals[i];
7921   }
7922   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7923   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7924   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7925   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7926   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7927   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7928 
7929 #if 0
7930   if (!restrict_comm) { /* check */
7931     Vec       lvec,rvec;
7932     PetscReal infty_error;
7933 
7934     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7935     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7936     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7937     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7938     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7939     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7940     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7941     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7942     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7943   }
7944 #endif
7945 
7946   /* assemble new additional is (if any) */
7947   if (nis) {
7948     PetscInt **temp_idxs,*count_is,j,psum;
7949 
7950     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7951     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7952     ptr_idxs = recv_buffer_idxs_is;
7953     psum = 0;
7954     for (i=0;i<n_recvs;i++) {
7955       for (j=0;j<nis;j++) {
7956         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7957         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7958         psum += plen;
7959         ptr_idxs += plen+1; /* shift pointer to received data */
7960       }
7961     }
7962     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7963     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7964     for (i=1;i<nis;i++) {
7965       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7966     }
7967     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
7968     ptr_idxs = recv_buffer_idxs_is;
7969     for (i=0;i<n_recvs;i++) {
7970       for (j=0;j<nis;j++) {
7971         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7972         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
7973         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7974         ptr_idxs += plen+1; /* shift pointer to received data */
7975       }
7976     }
7977     for (i=0;i<nis;i++) {
7978       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7979       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7980       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7981     }
7982     ierr = PetscFree(count_is);CHKERRQ(ierr);
7983     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7984     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7985   }
7986   /* free workspace */
7987   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7988   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7989   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7990   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7991   if (isdense) {
7992     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7993     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7994     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7995   } else {
7996     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7997   }
7998   if (nis) {
7999     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8000     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
8001   }
8002 
8003   if (nvecs) {
8004     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8005     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8006     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8007     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8008     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
8009     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
8010     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
8011     /* set values */
8012     ptr_vals = recv_buffer_vecs;
8013     ptr_idxs = recv_buffer_idxs_local;
8014     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8015     for (i=0;i<n_recvs;i++) {
8016       PetscInt j;
8017       for (j=0;j<*(ptr_idxs+1);j++) {
8018         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8019       }
8020       ptr_idxs += olengths_idxs[i];
8021       ptr_vals += olengths_idxs[i]-2;
8022     }
8023     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8024     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
8025     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
8026   }
8027 
8028   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
8029   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
8030   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
8031   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
8032   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
8033   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8034   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8035   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8036   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8037   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8038   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8039   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8040   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8041   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8042   ierr = PetscFree(onodes);CHKERRQ(ierr);
8043   if (nis) {
8044     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8045     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8046     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8047   }
8048   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8049   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8050     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8051     for (i=0;i<nis;i++) {
8052       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8053     }
8054     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8055       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8056     }
8057     *mat_n = NULL;
8058   }
8059   PetscFunctionReturn(0);
8060 }
8061 
8062 /* temporary hack into ksp private data structure */
8063 #include <petsc/private/kspimpl.h>
8064 
8065 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8066 {
8067   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8068   PC_IS                  *pcis = (PC_IS*)pc->data;
8069   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8070   Mat                    coarsedivudotp = NULL;
8071   Mat                    coarseG,t_coarse_mat_is;
8072   MatNullSpace           CoarseNullSpace = NULL;
8073   ISLocalToGlobalMapping coarse_islg;
8074   IS                     coarse_is,*isarray,corners;
8075   PetscInt               i,im_active=-1,active_procs=-1;
8076   PetscInt               nis,nisdofs,nisneu,nisvert;
8077   PetscInt               coarse_eqs_per_proc;
8078   PC                     pc_temp;
8079   PCType                 coarse_pc_type;
8080   KSPType                coarse_ksp_type;
8081   PetscBool              multilevel_requested,multilevel_allowed;
8082   PetscBool              coarse_reuse;
8083   PetscInt               ncoarse,nedcfield;
8084   PetscBool              compute_vecs = PETSC_FALSE;
8085   PetscScalar            *array;
8086   MatReuse               coarse_mat_reuse;
8087   PetscBool              restr, full_restr, have_void;
8088   PetscMPIInt            size;
8089   PetscErrorCode         ierr;
8090 
8091   PetscFunctionBegin;
8092   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8093   /* Assign global numbering to coarse dofs */
8094   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 */
8095     PetscInt ocoarse_size;
8096     compute_vecs = PETSC_TRUE;
8097 
8098     pcbddc->new_primal_space = PETSC_TRUE;
8099     ocoarse_size = pcbddc->coarse_size;
8100     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8101     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8102     /* see if we can avoid some work */
8103     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8104       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8105       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8106         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8107         coarse_reuse = PETSC_FALSE;
8108       } else { /* we can safely reuse already computed coarse matrix */
8109         coarse_reuse = PETSC_TRUE;
8110       }
8111     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8112       coarse_reuse = PETSC_FALSE;
8113     }
8114     /* reset any subassembling information */
8115     if (!coarse_reuse || pcbddc->recompute_topography) {
8116       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8117     }
8118   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8119     coarse_reuse = PETSC_TRUE;
8120   }
8121   if (coarse_reuse && pcbddc->coarse_ksp) {
8122     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8123     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8124     coarse_mat_reuse = MAT_REUSE_MATRIX;
8125   } else {
8126     coarse_mat = NULL;
8127     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8128   }
8129 
8130   /* creates temporary l2gmap and IS for coarse indexes */
8131   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8132   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8133 
8134   /* creates temporary MATIS object for coarse matrix */
8135   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8136   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);
8137   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8138   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8139   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8140   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8141 
8142   /* count "active" (i.e. with positive local size) and "void" processes */
8143   im_active = !!(pcis->n);
8144   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8145 
8146   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8147   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8148   /* full_restr : just use the receivers from the subassembling pattern */
8149   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8150   coarse_mat_is        = NULL;
8151   multilevel_allowed   = PETSC_FALSE;
8152   multilevel_requested = PETSC_FALSE;
8153   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8154   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8155   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8156   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8157   if (multilevel_requested) {
8158     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8159     restr      = PETSC_FALSE;
8160     full_restr = PETSC_FALSE;
8161   } else {
8162     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8163     restr      = PETSC_TRUE;
8164     full_restr = PETSC_TRUE;
8165   }
8166   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8167   ncoarse = PetscMax(1,ncoarse);
8168   if (!pcbddc->coarse_subassembling) {
8169     if (pcbddc->coarsening_ratio > 1) {
8170       if (multilevel_requested) {
8171         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8172       } else {
8173         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8174       }
8175     } else {
8176       PetscMPIInt rank;
8177 
8178       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8179       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8180       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8181     }
8182   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8183     PetscInt    psum;
8184     if (pcbddc->coarse_ksp) psum = 1;
8185     else psum = 0;
8186     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8187     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8188   }
8189   /* determine if we can go multilevel */
8190   if (multilevel_requested) {
8191     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8192     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8193   }
8194   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8195 
8196   /* dump subassembling pattern */
8197   if (pcbddc->dbg_flag && multilevel_allowed) {
8198     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8199   }
8200   /* compute dofs splitting and neumann boundaries for coarse dofs */
8201   nedcfield = -1;
8202   corners = NULL;
8203   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8204     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8205     const PetscInt         *idxs;
8206     ISLocalToGlobalMapping tmap;
8207 
8208     /* create map between primal indices (in local representative ordering) and local primal numbering */
8209     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8210     /* allocate space for temporary storage */
8211     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8212     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8213     /* allocate for IS array */
8214     nisdofs = pcbddc->n_ISForDofsLocal;
8215     if (pcbddc->nedclocal) {
8216       if (pcbddc->nedfield > -1) {
8217         nedcfield = pcbddc->nedfield;
8218       } else {
8219         nedcfield = 0;
8220         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8221         nisdofs = 1;
8222       }
8223     }
8224     nisneu = !!pcbddc->NeumannBoundariesLocal;
8225     nisvert = 0; /* nisvert is not used */
8226     nis = nisdofs + nisneu + nisvert;
8227     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8228     /* dofs splitting */
8229     for (i=0;i<nisdofs;i++) {
8230       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8231       if (nedcfield != i) {
8232         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8233         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8234         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8235         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8236       } else {
8237         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8238         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8239         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8240         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8241         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8242       }
8243       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8244       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8245       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8246     }
8247     /* neumann boundaries */
8248     if (pcbddc->NeumannBoundariesLocal) {
8249       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8250       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8251       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8252       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8253       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8254       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8255       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8256       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8257     }
8258     /* coordinates */
8259     if (pcbddc->corner_selected) {
8260       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8261       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8262       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8263       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8264       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8265       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8266       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8267       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8268       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8269     }
8270     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8271     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8272     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8273   } else {
8274     nis = 0;
8275     nisdofs = 0;
8276     nisneu = 0;
8277     nisvert = 0;
8278     isarray = NULL;
8279   }
8280   /* destroy no longer needed map */
8281   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8282 
8283   /* subassemble */
8284   if (multilevel_allowed) {
8285     Vec       vp[1];
8286     PetscInt  nvecs = 0;
8287     PetscBool reuse,reuser;
8288 
8289     if (coarse_mat) reuse = PETSC_TRUE;
8290     else reuse = PETSC_FALSE;
8291     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8292     vp[0] = NULL;
8293     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8294       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8295       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8296       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8297       nvecs = 1;
8298 
8299       if (pcbddc->divudotp) {
8300         Mat      B,loc_divudotp;
8301         Vec      v,p;
8302         IS       dummy;
8303         PetscInt np;
8304 
8305         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8306         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8307         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8308         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8309         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8310         ierr = VecSet(p,1.);CHKERRQ(ierr);
8311         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8312         ierr = VecDestroy(&p);CHKERRQ(ierr);
8313         ierr = MatDestroy(&B);CHKERRQ(ierr);
8314         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8315         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8316         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8317         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8318         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8319         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8320         ierr = VecDestroy(&v);CHKERRQ(ierr);
8321       }
8322     }
8323     if (reuser) {
8324       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8325     } else {
8326       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8327     }
8328     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8329       PetscScalar       *arraym;
8330       const PetscScalar *arrayv;
8331       PetscInt          nl;
8332       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8333       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8334       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8335       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8336       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8337       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8338       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8339       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8340     } else {
8341       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8342     }
8343   } else {
8344     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8345   }
8346   if (coarse_mat_is || coarse_mat) {
8347     if (!multilevel_allowed) {
8348       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8349     } else {
8350       /* if this matrix is present, it means we are not reusing the coarse matrix */
8351       if (coarse_mat_is) {
8352         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8353         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8354         coarse_mat = coarse_mat_is;
8355       }
8356     }
8357   }
8358   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8359   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8360 
8361   /* create local to global scatters for coarse problem */
8362   if (compute_vecs) {
8363     PetscInt lrows;
8364     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8365     if (coarse_mat) {
8366       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8367     } else {
8368       lrows = 0;
8369     }
8370     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8371     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8372     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8373     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8374     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8375   }
8376   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8377 
8378   /* set defaults for coarse KSP and PC */
8379   if (multilevel_allowed) {
8380     coarse_ksp_type = KSPRICHARDSON;
8381     coarse_pc_type  = PCBDDC;
8382   } else {
8383     coarse_ksp_type = KSPPREONLY;
8384     coarse_pc_type  = PCREDUNDANT;
8385   }
8386 
8387   /* print some info if requested */
8388   if (pcbddc->dbg_flag) {
8389     if (!multilevel_allowed) {
8390       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8391       if (multilevel_requested) {
8392         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);
8393       } else if (pcbddc->max_levels) {
8394         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8395       }
8396       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8397     }
8398   }
8399 
8400   /* communicate coarse discrete gradient */
8401   coarseG = NULL;
8402   if (pcbddc->nedcG && multilevel_allowed) {
8403     MPI_Comm ccomm;
8404     if (coarse_mat) {
8405       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8406     } else {
8407       ccomm = MPI_COMM_NULL;
8408     }
8409     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8410   }
8411 
8412   /* create the coarse KSP object only once with defaults */
8413   if (coarse_mat) {
8414     PetscBool   isredundant,isbddc,force,valid;
8415     PetscViewer dbg_viewer = NULL;
8416 
8417     if (pcbddc->dbg_flag) {
8418       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8419       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8420     }
8421     if (!pcbddc->coarse_ksp) {
8422       char   prefix[256],str_level[16];
8423       size_t len;
8424 
8425       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8426       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8427       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8428       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8429       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8430       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8431       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8432       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8433       /* TODO is this logic correct? should check for coarse_mat type */
8434       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8435       /* prefix */
8436       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8437       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8438       if (!pcbddc->current_level) {
8439         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8440         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8441       } else {
8442         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8443         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8444         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8445         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8446         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8447         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8448         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8449       }
8450       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8451       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8452       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8453       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8454       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8455       /* allow user customization */
8456       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8457       /* get some info after set from options */
8458       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8459       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8460       force = PETSC_FALSE;
8461       ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8462       ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8463       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8464       if (multilevel_allowed && !force && !valid) {
8465         isbddc = PETSC_TRUE;
8466         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8467         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8468         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8469         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8470         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8471           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8472           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8473           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8474           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8475           pc_temp->setfromoptionscalled++;
8476         }
8477       }
8478     }
8479     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8480     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8481     if (nisdofs) {
8482       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8483       for (i=0;i<nisdofs;i++) {
8484         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8485       }
8486     }
8487     if (nisneu) {
8488       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8489       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8490     }
8491     if (nisvert) {
8492       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8493       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8494     }
8495     if (coarseG) {
8496       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8497     }
8498 
8499     /* get some info after set from options */
8500     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8501 
8502     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8503     if (isbddc && !multilevel_allowed) {
8504       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8505     }
8506     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8507     force = PETSC_FALSE;
8508     ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8509     ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8510     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8511       ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8512     }
8513     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8514     if (isredundant) {
8515       KSP inner_ksp;
8516       PC  inner_pc;
8517 
8518       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8519       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8520     }
8521 
8522     /* parameters which miss an API */
8523     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8524     if (isbddc) {
8525       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8526 
8527       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8528       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8529       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8530       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8531       if (pcbddc_coarse->benign_saddle_point) {
8532         Mat                    coarsedivudotp_is;
8533         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8534         IS                     row,col;
8535         const PetscInt         *gidxs;
8536         PetscInt               n,st,M,N;
8537 
8538         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8539         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8540         st   = st-n;
8541         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8542         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8543         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8544         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8545         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8546         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8547         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8548         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8549         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8550         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8551         ierr = ISDestroy(&row);CHKERRQ(ierr);
8552         ierr = ISDestroy(&col);CHKERRQ(ierr);
8553         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8554         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8555         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8556         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8557         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8558         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8559         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8560         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8561         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8562         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8563         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8564         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8565       }
8566     }
8567 
8568     /* propagate symmetry info of coarse matrix */
8569     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8570     if (pc->pmat->symmetric_set) {
8571       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8572     }
8573     if (pc->pmat->hermitian_set) {
8574       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8575     }
8576     if (pc->pmat->spd_set) {
8577       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8578     }
8579     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8580       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8581     }
8582     /* set operators */
8583     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8584     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8585     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8586     if (pcbddc->dbg_flag) {
8587       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8588     }
8589   }
8590   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8591   ierr = PetscFree(isarray);CHKERRQ(ierr);
8592 #if 0
8593   {
8594     PetscViewer viewer;
8595     char filename[256];
8596     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8597     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8598     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8599     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8600     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8601     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8602   }
8603 #endif
8604 
8605   if (corners) {
8606     Vec            gv;
8607     IS             is;
8608     const PetscInt *idxs;
8609     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8610     PetscScalar    *coords;
8611 
8612     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8613     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8614     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8615     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8616     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8617     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8618     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8619     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8620     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8621 
8622     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8623     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8624     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8625     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8626     for (i=0;i<n;i++) {
8627       for (d=0;d<cdim;d++) {
8628         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8629       }
8630     }
8631     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8632     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8633 
8634     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8635     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8636     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8637     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8638     ierr = PetscFree(coords);CHKERRQ(ierr);
8639     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8640     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8641     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8642     if (pcbddc->coarse_ksp) {
8643       PC        coarse_pc;
8644       PetscBool isbddc;
8645 
8646       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8647       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8648       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8649         PetscReal *realcoords;
8650 
8651         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8652 #if defined(PETSC_USE_COMPLEX)
8653         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8654         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8655 #else
8656         realcoords = coords;
8657 #endif
8658         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8659 #if defined(PETSC_USE_COMPLEX)
8660         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8661 #endif
8662       }
8663     }
8664     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8665     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8666   }
8667   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8668 
8669   if (pcbddc->coarse_ksp) {
8670     Vec crhs,csol;
8671 
8672     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8673     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8674     if (!csol) {
8675       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8676     }
8677     if (!crhs) {
8678       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8679     }
8680   }
8681   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8682 
8683   /* compute null space for coarse solver if the benign trick has been requested */
8684   if (pcbddc->benign_null) {
8685 
8686     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8687     for (i=0;i<pcbddc->benign_n;i++) {
8688       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8689     }
8690     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8691     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8692     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8693     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8694     if (coarse_mat) {
8695       Vec         nullv;
8696       PetscScalar *array,*array2;
8697       PetscInt    nl;
8698 
8699       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8700       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8701       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8702       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8703       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8704       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8705       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8706       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8707       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8708       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8709     }
8710   }
8711   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8712 
8713   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8714   if (pcbddc->coarse_ksp) {
8715     PetscBool ispreonly;
8716 
8717     if (CoarseNullSpace) {
8718       PetscBool isnull;
8719       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8720       if (isnull) {
8721         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8722       }
8723       /* TODO: add local nullspaces (if any) */
8724     }
8725     /* setup coarse ksp */
8726     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8727     /* Check coarse problem if in debug mode or if solving with an iterative method */
8728     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8729     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8730       KSP       check_ksp;
8731       KSPType   check_ksp_type;
8732       PC        check_pc;
8733       Vec       check_vec,coarse_vec;
8734       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8735       PetscInt  its;
8736       PetscBool compute_eigs;
8737       PetscReal *eigs_r,*eigs_c;
8738       PetscInt  neigs;
8739       const char *prefix;
8740 
8741       /* Create ksp object suitable for estimation of extreme eigenvalues */
8742       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8743       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8744       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8745       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8746       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8747       /* prevent from setup unneeded object */
8748       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8749       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8750       if (ispreonly) {
8751         check_ksp_type = KSPPREONLY;
8752         compute_eigs = PETSC_FALSE;
8753       } else {
8754         check_ksp_type = KSPGMRES;
8755         compute_eigs = PETSC_TRUE;
8756       }
8757       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8758       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8759       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8760       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8761       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8762       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8763       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8764       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8765       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8766       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8767       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8768       /* create random vec */
8769       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8770       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8771       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8772       /* solve coarse problem */
8773       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8774       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8775       /* set eigenvalue estimation if preonly has not been requested */
8776       if (compute_eigs) {
8777         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8778         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8779         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8780         if (neigs) {
8781           lambda_max = eigs_r[neigs-1];
8782           lambda_min = eigs_r[0];
8783           if (pcbddc->use_coarse_estimates) {
8784             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8785               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8786               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8787             }
8788           }
8789         }
8790       }
8791 
8792       /* check coarse problem residual error */
8793       if (pcbddc->dbg_flag) {
8794         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8795         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8796         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8797         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8798         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8799         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8800         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8801         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8802         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8803         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8804         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8805         if (CoarseNullSpace) {
8806           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8807         }
8808         if (compute_eigs) {
8809           PetscReal          lambda_max_s,lambda_min_s;
8810           KSPConvergedReason reason;
8811           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8812           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8813           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8814           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8815           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);
8816           for (i=0;i<neigs;i++) {
8817             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8818           }
8819         }
8820         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8821         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8822       }
8823       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8824       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8825       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8826       if (compute_eigs) {
8827         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8828         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8829       }
8830     }
8831   }
8832   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8833   /* print additional info */
8834   if (pcbddc->dbg_flag) {
8835     /* waits until all processes reaches this point */
8836     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8837     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8838     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8839   }
8840 
8841   /* free memory */
8842   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8843   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8844   PetscFunctionReturn(0);
8845 }
8846 
8847 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8848 {
8849   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8850   PC_IS*         pcis = (PC_IS*)pc->data;
8851   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8852   IS             subset,subset_mult,subset_n;
8853   PetscInt       local_size,coarse_size=0;
8854   PetscInt       *local_primal_indices=NULL;
8855   const PetscInt *t_local_primal_indices;
8856   PetscErrorCode ierr;
8857 
8858   PetscFunctionBegin;
8859   /* Compute global number of coarse dofs */
8860   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8861   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8862   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8863   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8864   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8865   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8866   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8867   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8868   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8869   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);
8870   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8871   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8872   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8873   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8874   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8875 
8876   /* check numbering */
8877   if (pcbddc->dbg_flag) {
8878     PetscScalar coarsesum,*array,*array2;
8879     PetscInt    i;
8880     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8881 
8882     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8883     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8884     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8885     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8886     /* counter */
8887     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8888     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8889     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8890     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8891     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8892     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8893     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8894     for (i=0;i<pcbddc->local_primal_size;i++) {
8895       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8896     }
8897     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8898     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8899     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8900     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8901     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8902     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8903     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8904     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8905     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8906     for (i=0;i<pcis->n;i++) {
8907       if (array[i] != 0.0 && array[i] != array2[i]) {
8908         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8909         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8910         set_error = PETSC_TRUE;
8911         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8912         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);
8913       }
8914     }
8915     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8916     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8917     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8918     for (i=0;i<pcis->n;i++) {
8919       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8920     }
8921     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8922     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8923     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8924     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8925     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8926     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8927     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8928       PetscInt *gidxs;
8929 
8930       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8931       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8932       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8933       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8934       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8935       for (i=0;i<pcbddc->local_primal_size;i++) {
8936         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);
8937       }
8938       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8939       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8940     }
8941     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8942     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8943     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8944   }
8945 
8946   /* get back data */
8947   *coarse_size_n = coarse_size;
8948   *local_primal_indices_n = local_primal_indices;
8949   PetscFunctionReturn(0);
8950 }
8951 
8952 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8953 {
8954   IS             localis_t;
8955   PetscInt       i,lsize,*idxs,n;
8956   PetscScalar    *vals;
8957   PetscErrorCode ierr;
8958 
8959   PetscFunctionBegin;
8960   /* get indices in local ordering exploiting local to global map */
8961   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8962   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8963   for (i=0;i<lsize;i++) vals[i] = 1.0;
8964   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8965   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8966   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8967   if (idxs) { /* multilevel guard */
8968     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8969     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8970   }
8971   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8972   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8973   ierr = PetscFree(vals);CHKERRQ(ierr);
8974   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8975   /* now compute set in local ordering */
8976   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8977   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8978   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8979   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8980   for (i=0,lsize=0;i<n;i++) {
8981     if (PetscRealPart(vals[i]) > 0.5) {
8982       lsize++;
8983     }
8984   }
8985   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8986   for (i=0,lsize=0;i<n;i++) {
8987     if (PetscRealPart(vals[i]) > 0.5) {
8988       idxs[lsize++] = i;
8989     }
8990   }
8991   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8992   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8993   *localis = localis_t;
8994   PetscFunctionReturn(0);
8995 }
8996 
8997 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8998 {
8999   PC_IS               *pcis=(PC_IS*)pc->data;
9000   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9001   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9002   Mat                 S_j;
9003   PetscInt            *used_xadj,*used_adjncy;
9004   PetscBool           free_used_adj;
9005   PetscErrorCode      ierr;
9006 
9007   PetscFunctionBegin;
9008   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9009   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9010   free_used_adj = PETSC_FALSE;
9011   if (pcbddc->sub_schurs_layers == -1) {
9012     used_xadj = NULL;
9013     used_adjncy = NULL;
9014   } else {
9015     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9016       used_xadj = pcbddc->mat_graph->xadj;
9017       used_adjncy = pcbddc->mat_graph->adjncy;
9018     } else if (pcbddc->computed_rowadj) {
9019       used_xadj = pcbddc->mat_graph->xadj;
9020       used_adjncy = pcbddc->mat_graph->adjncy;
9021     } else {
9022       PetscBool      flg_row=PETSC_FALSE;
9023       const PetscInt *xadj,*adjncy;
9024       PetscInt       nvtxs;
9025 
9026       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9027       if (flg_row) {
9028         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
9029         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
9030         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
9031         free_used_adj = PETSC_TRUE;
9032       } else {
9033         pcbddc->sub_schurs_layers = -1;
9034         used_xadj = NULL;
9035         used_adjncy = NULL;
9036       }
9037       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9038     }
9039   }
9040 
9041   /* setup sub_schurs data */
9042   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9043   if (!sub_schurs->schur_explicit) {
9044     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9045     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9046     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);
9047   } else {
9048     Mat       change = NULL;
9049     Vec       scaling = NULL;
9050     IS        change_primal = NULL, iP;
9051     PetscInt  benign_n;
9052     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9053     PetscBool isseqaij,need_change = PETSC_FALSE;
9054     PetscBool discrete_harmonic = PETSC_FALSE;
9055 
9056     if (!pcbddc->use_vertices && reuse_solvers) {
9057       PetscInt n_vertices;
9058 
9059       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9060       reuse_solvers = (PetscBool)!n_vertices;
9061     }
9062     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
9063     if (!isseqaij) {
9064       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
9065       if (matis->A == pcbddc->local_mat) {
9066         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
9067         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9068       } else {
9069         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
9070       }
9071     }
9072     if (!pcbddc->benign_change_explicit) {
9073       benign_n = pcbddc->benign_n;
9074     } else {
9075       benign_n = 0;
9076     }
9077     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9078        We need a global reduction to avoid possible deadlocks.
9079        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9080     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9081       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9082       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9083       need_change = (PetscBool)(!need_change);
9084     }
9085     /* If the user defines additional constraints, we import them here.
9086        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 */
9087     if (need_change) {
9088       PC_IS   *pcisf;
9089       PC_BDDC *pcbddcf;
9090       PC      pcf;
9091 
9092       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9093       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9094       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9095       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9096 
9097       /* hacks */
9098       pcisf                        = (PC_IS*)pcf->data;
9099       pcisf->is_B_local            = pcis->is_B_local;
9100       pcisf->vec1_N                = pcis->vec1_N;
9101       pcisf->BtoNmap               = pcis->BtoNmap;
9102       pcisf->n                     = pcis->n;
9103       pcisf->n_B                   = pcis->n_B;
9104       pcbddcf                      = (PC_BDDC*)pcf->data;
9105       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9106       pcbddcf->mat_graph           = pcbddc->mat_graph;
9107       pcbddcf->use_faces           = PETSC_TRUE;
9108       pcbddcf->use_change_of_basis = PETSC_TRUE;
9109       pcbddcf->use_change_on_faces = PETSC_TRUE;
9110       pcbddcf->use_qr_single       = PETSC_TRUE;
9111       pcbddcf->fake_change         = PETSC_TRUE;
9112 
9113       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9114       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9115       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9116       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9117       change = pcbddcf->ConstraintMatrix;
9118       pcbddcf->ConstraintMatrix = NULL;
9119 
9120       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9121       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9122       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9123       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9124       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9125       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9126       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9127       pcf->ops->destroy = NULL;
9128       pcf->ops->reset   = NULL;
9129       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9130     }
9131     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9132 
9133     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9134     if (iP) {
9135       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9136       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9137       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9138     }
9139     if (discrete_harmonic) {
9140       Mat A;
9141       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9142       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9143       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9144       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);
9145       ierr = MatDestroy(&A);CHKERRQ(ierr);
9146     } else {
9147       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);
9148     }
9149     ierr = MatDestroy(&change);CHKERRQ(ierr);
9150     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9151   }
9152   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9153 
9154   /* free adjacency */
9155   if (free_used_adj) {
9156     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9157   }
9158   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9159   PetscFunctionReturn(0);
9160 }
9161 
9162 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9163 {
9164   PC_IS               *pcis=(PC_IS*)pc->data;
9165   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9166   PCBDDCGraph         graph;
9167   PetscErrorCode      ierr;
9168 
9169   PetscFunctionBegin;
9170   /* attach interface graph for determining subsets */
9171   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9172     IS       verticesIS,verticescomm;
9173     PetscInt vsize,*idxs;
9174 
9175     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9176     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9177     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9178     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9179     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9180     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9181     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9182     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9183     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9184     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9185     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9186   } else {
9187     graph = pcbddc->mat_graph;
9188   }
9189   /* print some info */
9190   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9191     IS       vertices;
9192     PetscInt nv,nedges,nfaces;
9193     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9194     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9195     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9196     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9197     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9198     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9199     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9200     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9201     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9202     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9203     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9204   }
9205 
9206   /* sub_schurs init */
9207   if (!pcbddc->sub_schurs) {
9208     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9209   }
9210   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);
9211 
9212   /* free graph struct */
9213   if (pcbddc->sub_schurs_rebuild) {
9214     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9215   }
9216   PetscFunctionReturn(0);
9217 }
9218 
9219 PetscErrorCode PCBDDCCheckOperator(PC pc)
9220 {
9221   PC_IS               *pcis=(PC_IS*)pc->data;
9222   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9223   PetscErrorCode      ierr;
9224 
9225   PetscFunctionBegin;
9226   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9227     IS             zerodiag = NULL;
9228     Mat            S_j,B0_B=NULL;
9229     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9230     PetscScalar    *p0_check,*array,*array2;
9231     PetscReal      norm;
9232     PetscInt       i;
9233 
9234     /* B0 and B0_B */
9235     if (zerodiag) {
9236       IS       dummy;
9237 
9238       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9239       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9240       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9241       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9242     }
9243     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9244     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9245     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9246     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9247     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9248     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9249     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9250     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9251     /* S_j */
9252     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9253     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9254 
9255     /* mimic vector in \widetilde{W}_\Gamma */
9256     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9257     /* continuous in primal space */
9258     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9259     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9260     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9261     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9262     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9263     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9264     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9265     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9266     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9267     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9268     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9269     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9270     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9271     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9272 
9273     /* assemble rhs for coarse problem */
9274     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9275     /* local with Schur */
9276     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9277     if (zerodiag) {
9278       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9279       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9280       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9281       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9282     }
9283     /* sum on primal nodes the local contributions */
9284     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9285     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9286     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9287     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9288     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9289     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9290     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9291     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9292     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9293     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9294     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9295     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9296     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9297     /* scale primal nodes (BDDC sums contibutions) */
9298     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9299     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9300     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9301     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9302     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9303     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9304     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9305     /* global: \widetilde{B0}_B w_\Gamma */
9306     if (zerodiag) {
9307       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9308       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9309       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9310       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9311     }
9312     /* BDDC */
9313     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9314     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9315 
9316     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9317     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9318     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9319     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9320     for (i=0;i<pcbddc->benign_n;i++) {
9321       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);
9322     }
9323     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9324     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9325     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9326     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9327     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9328     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9329   }
9330   PetscFunctionReturn(0);
9331 }
9332 
9333 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9334 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9335 {
9336   Mat            At;
9337   IS             rows;
9338   PetscInt       rst,ren;
9339   PetscErrorCode ierr;
9340   PetscLayout    rmap;
9341 
9342   PetscFunctionBegin;
9343   rst = ren = 0;
9344   if (ccomm != MPI_COMM_NULL) {
9345     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9346     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9347     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9348     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9349     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9350   }
9351   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9352   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9353   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9354 
9355   if (ccomm != MPI_COMM_NULL) {
9356     Mat_MPIAIJ *a,*b;
9357     IS         from,to;
9358     Vec        gvec;
9359     PetscInt   lsize;
9360 
9361     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9362     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9363     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9364     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9365     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9366     a    = (Mat_MPIAIJ*)At->data;
9367     b    = (Mat_MPIAIJ*)(*B)->data;
9368     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9369     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9370     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9371     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9372     b->A = a->A;
9373     b->B = a->B;
9374 
9375     b->donotstash      = a->donotstash;
9376     b->roworiented     = a->roworiented;
9377     b->rowindices      = 0;
9378     b->rowvalues       = 0;
9379     b->getrowactive    = PETSC_FALSE;
9380 
9381     (*B)->rmap         = rmap;
9382     (*B)->factortype   = A->factortype;
9383     (*B)->assembled    = PETSC_TRUE;
9384     (*B)->insertmode   = NOT_SET_VALUES;
9385     (*B)->preallocated = PETSC_TRUE;
9386 
9387     if (a->colmap) {
9388 #if defined(PETSC_USE_CTABLE)
9389       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9390 #else
9391       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9392       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9393       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9394 #endif
9395     } else b->colmap = 0;
9396     if (a->garray) {
9397       PetscInt len;
9398       len  = a->B->cmap->n;
9399       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9400       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9401       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9402     } else b->garray = 0;
9403 
9404     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9405     b->lvec = a->lvec;
9406     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9407 
9408     /* cannot use VecScatterCopy */
9409     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9410     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9411     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9412     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9413     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9414     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9415     ierr = ISDestroy(&from);CHKERRQ(ierr);
9416     ierr = ISDestroy(&to);CHKERRQ(ierr);
9417     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9418   }
9419   ierr = MatDestroy(&At);CHKERRQ(ierr);
9420   PetscFunctionReturn(0);
9421 }
9422