xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision d7cc930e14e615e9907267aaa472dd0ccceeab82)
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   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
26   if (!nr || !nc) PetscFunctionReturn(0);
27 
28   /* workspace */
29   if (!work) {
30     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
31     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
32   } else {
33     ulw   = lw;
34     uwork = work;
35   }
36   n = PetscMin(nr,nc);
37   if (!rwork) {
38     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
39   } else {
40     sing = rwork;
41   }
42 
43   /* SVD */
44   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
45   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
48   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
49   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
50   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
51   ierr = PetscFPTrapPop();CHKERRQ(ierr);
52   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
53   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
54   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
55   if (!rwork) {
56     ierr = PetscFree(sing);CHKERRQ(ierr);
57   }
58   if (!work) {
59     ierr = PetscFree(uwork);CHKERRQ(ierr);
60   }
61   /* create B */
62   if (!range) {
63     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
64     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
65     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
66   } else {
67     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
68     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
69     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
70   }
71   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
72   ierr = PetscFree(U);CHKERRQ(ierr);
73 #else /* PETSC_USE_COMPLEX */
74   PetscFunctionBegin;
75   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
76 #endif
77   PetscFunctionReturn(0);
78 }
79 
80 /* TODO REMOVE */
81 #if defined(PRINT_GDET)
82 static int inc = 0;
83 static int lev = 0;
84 #endif
85 
86 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
87 {
88   PetscErrorCode ierr;
89   Mat            GE,GEd;
90   PetscInt       rsize,csize,esize;
91   PetscScalar    *ptr;
92 
93   PetscFunctionBegin;
94   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
95   if (!esize) PetscFunctionReturn(0);
96   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
97   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
98 
99   /* gradients */
100   ptr  = work + 5*esize;
101   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
102   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
103   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
104   ierr = MatDestroy(&GE);CHKERRQ(ierr);
105 
106   /* constants */
107   ptr += rsize*csize;
108   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
109   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
110   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
111   ierr = MatDestroy(&GE);CHKERRQ(ierr);
112   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
113   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
114 
115   if (corners) {
116     Mat               GEc;
117     const PetscScalar *vals;
118     PetscScalar       v;
119 
120     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
121     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
122     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
123     /* v    = PetscAbsScalar(vals[0]) */;
124     v    = 1.;
125     cvals[0] = vals[0]/v;
126     cvals[1] = vals[1]/v;
127     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
128     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
129 #if defined(PRINT_GDET)
130     {
131       PetscViewer viewer;
132       char filename[256];
133       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
134       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
135       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
136       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
137       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
138       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
139       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
141       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
142       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
143     }
144 #endif
145     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
146     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
147   }
148 
149   PetscFunctionReturn(0);
150 }
151 
152 PetscErrorCode PCBDDCNedelecSupport(PC pc)
153 {
154   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
155   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
156   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
157   Vec                    tvec;
158   PetscSF                sfv;
159   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
160   MPI_Comm               comm;
161   IS                     lned,primals,allprimals,nedfieldlocal;
162   IS                     *eedges,*extrows,*extcols,*alleedges;
163   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
164   PetscScalar            *vals,*work;
165   PetscReal              *rwork;
166   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
167   PetscInt               ne,nv,Lv,order,n,field;
168   PetscInt               n_neigh,*neigh,*n_shared,**shared;
169   PetscInt               i,j,extmem,cum,maxsize,nee;
170   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
171   PetscInt               *sfvleaves,*sfvroots;
172   PetscInt               *corners,*cedges;
173   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
174   PetscInt               *emarks;
175   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
176   PetscErrorCode         ierr;
177 
178   PetscFunctionBegin;
179   /* If the discrete gradient is defined for a subset of dofs and global is true,
180      it assumes G is given in global ordering for all the dofs.
181      Otherwise, the ordering is global for the Nedelec field */
182   order      = pcbddc->nedorder;
183   conforming = pcbddc->conforming;
184   field      = pcbddc->nedfield;
185   global     = pcbddc->nedglobal;
186   setprimal  = PETSC_FALSE;
187   print      = PETSC_FALSE;
188   singular   = PETSC_FALSE;
189 
190   /* Command line customization */
191   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
192   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
193   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
194   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
195   /* print debug info TODO: to be removed */
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsEnd();CHKERRQ(ierr);
198 
199   /* Return if there are no edges in the decomposition and the problem is not singular */
200   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
201   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
202   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
203   if (!singular) {
204     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
205     lrc[0] = PETSC_FALSE;
206     for (i=0;i<n;i++) {
207       if (PetscRealPart(vals[i]) > 2.) {
208         lrc[0] = PETSC_TRUE;
209         break;
210       }
211     }
212     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
213     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
214     if (!lrc[1]) PetscFunctionReturn(0);
215   }
216 
217   /* Get Nedelec field */
218   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);
219   if (pcbddc->n_ISForDofsLocal && field >= 0) {
220     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
221     nedfieldlocal = pcbddc->ISForDofsLocal[field];
222     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
223   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
224     ne            = n;
225     nedfieldlocal = NULL;
226     global        = PETSC_TRUE;
227   } else if (field == PETSC_DECIDE) {
228     PetscInt rst,ren,*idx;
229 
230     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
231     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
232     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
233     for (i=rst;i<ren;i++) {
234       PetscInt nc;
235 
236       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
237       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
238       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
239     }
240     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
241     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
242     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
243     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
244     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
245   } else {
246     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
247   }
248 
249   /* Sanity checks */
250   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
251   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
252   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);
253 
254   /* Just set primal dofs and return */
255   if (setprimal) {
256     IS       enedfieldlocal;
257     PetscInt *eidxs;
258 
259     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
260     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
261     if (nedfieldlocal) {
262       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
263       for (i=0,cum=0;i<ne;i++) {
264         if (PetscRealPart(vals[idxs[i]]) > 2.) {
265           eidxs[cum++] = idxs[i];
266         }
267       }
268       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269     } else {
270       for (i=0,cum=0;i<ne;i++) {
271         if (PetscRealPart(vals[i]) > 2.) {
272           eidxs[cum++] = i;
273         }
274       }
275     }
276     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
277     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
278     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
279     ierr = PetscFree(eidxs);CHKERRQ(ierr);
280     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
281     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
282     PetscFunctionReturn(0);
283   }
284 
285   /* Compute some l2g maps */
286   if (nedfieldlocal) {
287     IS is;
288 
289     /* need to map from the local Nedelec field to local numbering */
290     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
291     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
292     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
293     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
294     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
295     if (global) {
296       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
297       el2g = al2g;
298     } else {
299       IS gis;
300 
301       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
302       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
303       ierr = ISDestroy(&gis);CHKERRQ(ierr);
304     }
305     ierr = ISDestroy(&is);CHKERRQ(ierr);
306   } else {
307     /* restore default */
308     pcbddc->nedfield = -1;
309     /* one ref for the destruction of al2g, one for el2g */
310     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
311     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
312     el2g = al2g;
313     fl2g = NULL;
314   }
315 
316   /* Start communication to drop connections for interior edges (for cc analysis only) */
317   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
318   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
319   if (nedfieldlocal) {
320     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
321     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
322     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
323   } else {
324     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
325   }
326   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
327   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
328 
329   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
330     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
331     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
332     if (global) {
333       PetscInt rst;
334 
335       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
336       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
337         if (matis->sf_rootdata[i] < 2) {
338           matis->sf_rootdata[cum++] = i + rst;
339         }
340       }
341       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
342       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
343     } else {
344       PetscInt *tbz;
345 
346       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
347       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
348       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
349       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
350       for (i=0,cum=0;i<ne;i++)
351         if (matis->sf_leafdata[idxs[i]] == 1)
352           tbz[cum++] = i;
353       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
355       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
356       ierr = PetscFree(tbz);CHKERRQ(ierr);
357     }
358   } else { /* we need the entire G to infer the nullspace */
359     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
360     G    = pcbddc->discretegradient;
361   }
362 
363   /* Extract subdomain relevant rows of G */
364   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
365   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
366   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
367   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
368   ierr = ISDestroy(&lned);CHKERRQ(ierr);
369   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
370   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
371   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
372 
373   /* SF for nodal dofs communications */
374   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
375   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
376   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
377   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
378   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
379   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
380   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
382   i    = singular ? 2 : 1;
383   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
384 
385   /* Destroy temporary G created in MATIS format and modified G */
386   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
387   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
388   ierr = MatDestroy(&G);CHKERRQ(ierr);
389 
390   if (print) {
391     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
392     ierr = MatView(lG,NULL);CHKERRQ(ierr);
393   }
394 
395   /* Save lG for values insertion in change of basis */
396   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
397 
398   /* Analyze the edge-nodes connections (duplicate lG) */
399   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
400   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
401   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
402   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
403   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
404   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
406   /* need to import the boundary specification to ensure the
407      proper detection of coarse edges' endpoints */
408   if (pcbddc->DirichletBoundariesLocal) {
409     IS is;
410 
411     if (fl2g) {
412       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
413     } else {
414       is = pcbddc->DirichletBoundariesLocal;
415     }
416     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
417     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
418     for (i=0;i<cum;i++) {
419       if (idxs[i] >= 0) {
420         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
421         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
422       }
423     }
424     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
425     if (fl2g) {
426       ierr = ISDestroy(&is);CHKERRQ(ierr);
427     }
428   }
429   if (pcbddc->NeumannBoundariesLocal) {
430     IS is;
431 
432     if (fl2g) {
433       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
434     } else {
435       is = pcbddc->NeumannBoundariesLocal;
436     }
437     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
438     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
439     for (i=0;i<cum;i++) {
440       if (idxs[i] >= 0) {
441         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
442       }
443     }
444     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
445     if (fl2g) {
446       ierr = ISDestroy(&is);CHKERRQ(ierr);
447     }
448   }
449 
450   /* Count neighs per dof */
451   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
452   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
453 
454   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
455      for proper detection of coarse edges' endpoints */
456   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
457   for (i=0;i<ne;i++) {
458     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
459       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
460     }
461   }
462   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
463   if (!conforming) {
464     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
465     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
466   }
467   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
468   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
469   cum  = 0;
470   for (i=0;i<ne;i++) {
471     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
472     if (!PetscBTLookup(btee,i)) {
473       marks[cum++] = i;
474       continue;
475     }
476     /* set badly connected edge dofs as primal */
477     if (!conforming) {
478       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
479         marks[cum++] = i;
480         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
481         for (j=ii[i];j<ii[i+1];j++) {
482           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
483         }
484       } else {
485         /* every edge dofs should be connected trough a certain number of nodal dofs
486            to other edge dofs belonging to coarse edges
487            - at most 2 endpoints
488            - order-1 interior nodal dofs
489            - no undefined nodal dofs (nconn < order)
490         */
491         PetscInt ends = 0,ints = 0, undef = 0;
492         for (j=ii[i];j<ii[i+1];j++) {
493           PetscInt v = jj[j],k;
494           PetscInt nconn = iit[v+1]-iit[v];
495           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
496           if (nconn > order) ends++;
497           else if (nconn == order) ints++;
498           else undef++;
499         }
500         if (undef || ends > 2 || ints != order -1) {
501           marks[cum++] = i;
502           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
503           for (j=ii[i];j<ii[i+1];j++) {
504             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
505           }
506         }
507       }
508     }
509     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
510     if (!order && ii[i+1] != ii[i]) {
511       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
512       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
513     }
514   }
515   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
516   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
517   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
518   if (!conforming) {
519     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
520     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
521   }
522   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
523 
524   /* identify splitpoints and corner candidates */
525   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
526   if (print) {
527     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
528     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
529     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
530     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
531   }
532   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
533   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
534   for (i=0;i<nv;i++) {
535     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
536     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
537     if (!order) { /* variable order */
538       PetscReal vorder = 0.;
539 
540       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
541       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
542       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
543       ord  = 1;
544     }
545     if (PetscUnlikelyDebug(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);
546     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
547       if (PetscBTLookup(btbd,jj[j])) {
548         bdir = PETSC_TRUE;
549         break;
550       }
551       if (vc != ecount[jj[j]]) {
552         sneighs = PETSC_FALSE;
553       } else {
554         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
555         for (k=0;k<vc;k++) {
556           if (vn[k] != en[k]) {
557             sneighs = PETSC_FALSE;
558             break;
559           }
560         }
561       }
562     }
563     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
564       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
565       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
566     } else if (test == ord) {
567       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
568         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
569         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
570       } else {
571         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
572         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
573       }
574     }
575   }
576   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
577   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
578   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
579 
580   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
581   if (order != 1) {
582     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
583     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
584     for (i=0;i<nv;i++) {
585       if (PetscBTLookup(btvcand,i)) {
586         PetscBool found = PETSC_FALSE;
587         for (j=ii[i];j<ii[i+1] && !found;j++) {
588           PetscInt k,e = jj[j];
589           if (PetscBTLookup(bte,e)) continue;
590           for (k=iit[e];k<iit[e+1];k++) {
591             PetscInt v = jjt[k];
592             if (v != i && PetscBTLookup(btvcand,v)) {
593               found = PETSC_TRUE;
594               break;
595             }
596           }
597         }
598         if (!found) {
599           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
600           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
601         } else {
602           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
603         }
604       }
605     }
606     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
607   }
608   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
609   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
610   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
611 
612   /* Get the local G^T explicitly */
613   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
614   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
615   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
616 
617   /* Mark interior nodal dofs */
618   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
619   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
620   for (i=1;i<n_neigh;i++) {
621     for (j=0;j<n_shared[i];j++) {
622       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
623     }
624   }
625   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
626 
627   /* communicate corners and splitpoints */
628   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
629   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
630   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
631   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
632 
633   if (print) {
634     IS tbz;
635 
636     cum = 0;
637     for (i=0;i<nv;i++)
638       if (sfvleaves[i])
639         vmarks[cum++] = i;
640 
641     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
642     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
643     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
644     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
645   }
646 
647   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
648   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
649   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
650   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
651 
652   /* Zero rows of lGt corresponding to identified corners
653      and interior nodal dofs */
654   cum = 0;
655   for (i=0;i<nv;i++) {
656     if (sfvleaves[i]) {
657       vmarks[cum++] = i;
658       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
659     }
660     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
661   }
662   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
663   if (print) {
664     IS tbz;
665 
666     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
667     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
668     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
669     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
670   }
671   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
672   ierr = PetscFree(vmarks);CHKERRQ(ierr);
673   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
674   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
675 
676   /* Recompute G */
677   ierr = MatDestroy(&lG);CHKERRQ(ierr);
678   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
679   if (print) {
680     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
681     ierr = MatView(lG,NULL);CHKERRQ(ierr);
682     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
683     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
684   }
685 
686   /* Get primal dofs (if any) */
687   cum = 0;
688   for (i=0;i<ne;i++) {
689     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
690   }
691   if (fl2g) {
692     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
693   }
694   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
695   if (print) {
696     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
697     ierr = ISView(primals,NULL);CHKERRQ(ierr);
698   }
699   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
700   /* TODO: what if the user passed in some of them ?  */
701   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
702   ierr = ISDestroy(&primals);CHKERRQ(ierr);
703 
704   /* Compute edge connectivity */
705   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
706 
707   /* Symbolic conn = lG*lGt */
708   ierr = MatProductCreate(lG,lGt,NULL,&conn);CHKERRQ(ierr);
709   ierr = MatProductSetType(conn,MATPRODUCT_AB);CHKERRQ(ierr);
710   ierr = MatProductSetAlgorithm(conn,"default");CHKERRQ(ierr);
711   ierr = MatProductSetFill(conn,PETSC_DEFAULT);CHKERRQ(ierr);
712   ierr = PetscObjectSetOptionsPrefix((PetscObject)conn,"econn_");CHKERRQ(ierr);
713   ierr = MatProductSetFromOptions(conn);CHKERRQ(ierr);
714   ierr = MatProductSymbolic(conn);CHKERRQ(ierr);
715 
716   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
717   if (fl2g) {
718     PetscBT   btf;
719     PetscInt  *iia,*jja,*iiu,*jju;
720     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
721 
722     /* create CSR for all local dofs */
723     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
724     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
725       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);
726       iiu = pcbddc->mat_graph->xadj;
727       jju = pcbddc->mat_graph->adjncy;
728     } else if (pcbddc->use_local_adj) {
729       rest = PETSC_TRUE;
730       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
731     } else {
732       free   = PETSC_TRUE;
733       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
734       iiu[0] = 0;
735       for (i=0;i<n;i++) {
736         iiu[i+1] = i+1;
737         jju[i]   = -1;
738       }
739     }
740 
741     /* import sizes of CSR */
742     iia[0] = 0;
743     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
744 
745     /* overwrite entries corresponding to the Nedelec field */
746     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
747     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
748     for (i=0;i<ne;i++) {
749       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
750       iia[idxs[i]+1] = ii[i+1]-ii[i];
751     }
752 
753     /* iia in CSR */
754     for (i=0;i<n;i++) iia[i+1] += iia[i];
755 
756     /* jja in CSR */
757     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
758     for (i=0;i<n;i++)
759       if (!PetscBTLookup(btf,i))
760         for (j=0;j<iiu[i+1]-iiu[i];j++)
761           jja[iia[i]+j] = jju[iiu[i]+j];
762 
763     /* map edge dofs connectivity */
764     if (jj) {
765       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
766       for (i=0;i<ne;i++) {
767         PetscInt e = idxs[i];
768         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
769       }
770     }
771     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
772     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
773     if (rest) {
774       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
775     }
776     if (free) {
777       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
778     }
779     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
780   } else {
781     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
782   }
783 
784   /* Analyze interface for edge dofs */
785   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
786   pcbddc->mat_graph->twodim = PETSC_FALSE;
787 
788   /* Get coarse edges in the edge space */
789   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
790   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
791 
792   if (fl2g) {
793     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
794     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
795     for (i=0;i<nee;i++) {
796       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
797     }
798   } else {
799     eedges  = alleedges;
800     primals = allprimals;
801   }
802 
803   /* Mark fine edge dofs with their coarse edge id */
804   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
805   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
806   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
807   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
808   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
809   if (print) {
810     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
811     ierr = ISView(primals,NULL);CHKERRQ(ierr);
812   }
813 
814   maxsize = 0;
815   for (i=0;i<nee;i++) {
816     PetscInt size,mark = i+1;
817 
818     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
819     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
820     for (j=0;j<size;j++) marks[idxs[j]] = mark;
821     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
822     maxsize = PetscMax(maxsize,size);
823   }
824 
825   /* Find coarse edge endpoints */
826   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
827   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
828   for (i=0;i<nee;i++) {
829     PetscInt mark = i+1,size;
830 
831     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
832     if (!size && nedfieldlocal) continue;
833     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
834     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
835     if (print) {
836       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
837       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
838     }
839     for (j=0;j<size;j++) {
840       PetscInt k, ee = idxs[j];
841       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
842       for (k=ii[ee];k<ii[ee+1];k++) {
843         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
844         if (PetscBTLookup(btv,jj[k])) {
845           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
846         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
847           PetscInt  k2;
848           PetscBool corner = PETSC_FALSE;
849           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
850             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]));
851             /* it's a corner if either is connected with an edge dof belonging to a different cc or
852                if the edge dof lie on the natural part of the boundary */
853             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
854               corner = PETSC_TRUE;
855               break;
856             }
857           }
858           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
859             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
860             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
861           } else {
862             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
863           }
864         }
865       }
866     }
867     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
868   }
869   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
870   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
871   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
872 
873   /* Reset marked primal dofs */
874   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
875   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
876   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
877   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
878 
879   /* Now use the initial lG */
880   ierr = MatDestroy(&lG);CHKERRQ(ierr);
881   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
882   lG   = lGinit;
883   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
884 
885   /* Compute extended cols indices */
886   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
887   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
888   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
889   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
890   i   *= maxsize;
891   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
892   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
893   eerr = PETSC_FALSE;
894   for (i=0;i<nee;i++) {
895     PetscInt size,found = 0;
896 
897     cum  = 0;
898     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
899     if (!size && nedfieldlocal) continue;
900     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
901     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
902     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
903     for (j=0;j<size;j++) {
904       PetscInt k,ee = idxs[j];
905       for (k=ii[ee];k<ii[ee+1];k++) {
906         PetscInt vv = jj[k];
907         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
908         else if (!PetscBTLookupSet(btvc,vv)) found++;
909       }
910     }
911     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
912     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
913     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
914     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
915     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
916     /* it may happen that endpoints are not defined at this point
917        if it is the case, mark this edge for a second pass */
918     if (cum != size -1 || found != 2) {
919       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
920       if (print) {
921         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
922         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
923         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
924         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
925       }
926       eerr = PETSC_TRUE;
927     }
928   }
929   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
930   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
931   if (done) {
932     PetscInt *newprimals;
933 
934     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
935     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
936     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
937     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
938     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
939     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
940     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
941     for (i=0;i<nee;i++) {
942       PetscBool has_candidates = PETSC_FALSE;
943       if (PetscBTLookup(bter,i)) {
944         PetscInt size,mark = i+1;
945 
946         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
947         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
948         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
949         for (j=0;j<size;j++) {
950           PetscInt k,ee = idxs[j];
951           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
952           for (k=ii[ee];k<ii[ee+1];k++) {
953             /* set all candidates located on the edge as corners */
954             if (PetscBTLookup(btvcand,jj[k])) {
955               PetscInt k2,vv = jj[k];
956               has_candidates = PETSC_TRUE;
957               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
958               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
959               /* set all edge dofs connected to candidate as primals */
960               for (k2=iit[vv];k2<iit[vv+1];k2++) {
961                 if (marks[jjt[k2]] == mark) {
962                   PetscInt k3,ee2 = jjt[k2];
963                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
964                   newprimals[cum++] = ee2;
965                   /* finally set the new corners */
966                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
967                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
968                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
969                   }
970                 }
971               }
972             } else {
973               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
974             }
975           }
976         }
977         if (!has_candidates) { /* circular edge */
978           PetscInt k, ee = idxs[0],*tmarks;
979 
980           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
981           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
982           for (k=ii[ee];k<ii[ee+1];k++) {
983             PetscInt k2;
984             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
985             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
986             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
987           }
988           for (j=0;j<size;j++) {
989             if (tmarks[idxs[j]] > 1) {
990               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
991               newprimals[cum++] = idxs[j];
992             }
993           }
994           ierr = PetscFree(tmarks);CHKERRQ(ierr);
995         }
996         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
997       }
998       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
999     }
1000     ierr = PetscFree(extcols);CHKERRQ(ierr);
1001     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1002     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1003     if (fl2g) {
1004       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1005       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1006       for (i=0;i<nee;i++) {
1007         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1008       }
1009       ierr = PetscFree(eedges);CHKERRQ(ierr);
1010     }
1011     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1012     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1013     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1014     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1015     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1016     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1017     pcbddc->mat_graph->twodim = PETSC_FALSE;
1018     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1019     if (fl2g) {
1020       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1021       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1022       for (i=0;i<nee;i++) {
1023         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1024       }
1025     } else {
1026       eedges  = alleedges;
1027       primals = allprimals;
1028     }
1029     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1030 
1031     /* Mark again */
1032     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1033     for (i=0;i<nee;i++) {
1034       PetscInt size,mark = i+1;
1035 
1036       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1037       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1038       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1039       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1040     }
1041     if (print) {
1042       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1043       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1044     }
1045 
1046     /* Recompute extended cols */
1047     eerr = PETSC_FALSE;
1048     for (i=0;i<nee;i++) {
1049       PetscInt size;
1050 
1051       cum  = 0;
1052       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1053       if (!size && nedfieldlocal) continue;
1054       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1055       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1056       for (j=0;j<size;j++) {
1057         PetscInt k,ee = idxs[j];
1058         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1059       }
1060       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1061       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1062       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1063       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1064       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1065       if (cum != size -1) {
1066         if (print) {
1067           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1068           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1069           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1070           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1071         }
1072         eerr = PETSC_TRUE;
1073       }
1074     }
1075   }
1076   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1077   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1078   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1079   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1080   /* an error should not occur at this point */
1081   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1082 
1083   /* Check the number of endpoints */
1084   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1086   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1087   for (i=0;i<nee;i++) {
1088     PetscInt size, found = 0, gc[2];
1089 
1090     /* init with defaults */
1091     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1092     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1093     if (!size && nedfieldlocal) continue;
1094     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1095     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1096     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1097     for (j=0;j<size;j++) {
1098       PetscInt k,ee = idxs[j];
1099       for (k=ii[ee];k<ii[ee+1];k++) {
1100         PetscInt vv = jj[k];
1101         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1102           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1103           corners[i*2+found++] = vv;
1104         }
1105       }
1106     }
1107     if (found != 2) {
1108       PetscInt e;
1109       if (fl2g) {
1110         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1111       } else {
1112         e = idxs[0];
1113       }
1114       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1115     }
1116 
1117     /* get primal dof index on this coarse edge */
1118     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1119     if (gc[0] > gc[1]) {
1120       PetscInt swap  = corners[2*i];
1121       corners[2*i]   = corners[2*i+1];
1122       corners[2*i+1] = swap;
1123     }
1124     cedges[i] = idxs[size-1];
1125     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1126     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1127   }
1128   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1129   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1130 
1131   if (PetscDefined(USE_DEBUG)) {
1132     /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1133      not interfere with neighbouring coarse edges */
1134     ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1135     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1136     for (i=0;i<nv;i++) {
1137       PetscInt emax = 0,eemax = 0;
1138 
1139       if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1140       ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1141       for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1142       for (j=1;j<nee+1;j++) {
1143         if (emax < emarks[j]) {
1144           emax = emarks[j];
1145           eemax = j;
1146         }
1147       }
1148       /* not relevant for edges */
1149       if (!eemax) continue;
1150 
1151       for (j=ii[i];j<ii[i+1];j++) {
1152         if (marks[jj[j]] && marks[jj[j]] != eemax) {
1153           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]);
1154         }
1155       }
1156     }
1157     ierr = PetscFree(emarks);CHKERRQ(ierr);
1158     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1159   }
1160 
1161   /* Compute extended rows indices for edge blocks of the change of basis */
1162   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1163   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1164   extmem *= maxsize;
1165   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1166   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1167   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1168   for (i=0;i<nv;i++) {
1169     PetscInt mark = 0,size,start;
1170 
1171     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1172     for (j=ii[i];j<ii[i+1];j++)
1173       if (marks[jj[j]] && !mark)
1174         mark = marks[jj[j]];
1175 
1176     /* not relevant */
1177     if (!mark) continue;
1178 
1179     /* import extended row */
1180     mark--;
1181     start = mark*extmem+extrowcum[mark];
1182     size = ii[i+1]-ii[i];
1183     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1184     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1185     extrowcum[mark] += size;
1186   }
1187   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1188   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1189   ierr = PetscFree(marks);CHKERRQ(ierr);
1190 
1191   /* Compress extrows */
1192   cum  = 0;
1193   for (i=0;i<nee;i++) {
1194     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1195     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1196     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1197     cum  = PetscMax(cum,size);
1198   }
1199   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1201   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1202 
1203   /* Workspace for lapack inner calls and VecSetValues */
1204   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1205 
1206   /* Create change of basis matrix (preallocation can be improved) */
1207   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1208   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1209                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1210   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1211   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1212   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1213   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1216   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1217 
1218   /* Defaults to identity */
1219   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1220   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1221   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1222   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1223 
1224   /* Create discrete gradient for the coarser level if needed */
1225   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1226   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1227   if (pcbddc->current_level < pcbddc->max_levels) {
1228     ISLocalToGlobalMapping cel2g,cvl2g;
1229     IS                     wis,gwis;
1230     PetscInt               cnv,cne;
1231 
1232     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1233     if (fl2g) {
1234       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1235     } else {
1236       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1237       pcbddc->nedclocal = wis;
1238     }
1239     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1240     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1241     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1242     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1243     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1244     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1245 
1246     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1247     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1248     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1249     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1250     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1251     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1252     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1253 
1254     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1255     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1256     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1257     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1258     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1259     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1261     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1262   }
1263   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1264 
1265 #if defined(PRINT_GDET)
1266   inc = 0;
1267   lev = pcbddc->current_level;
1268 #endif
1269 
1270   /* Insert values in the change of basis matrix */
1271   for (i=0;i<nee;i++) {
1272     Mat         Gins = NULL, GKins = NULL;
1273     IS          cornersis = NULL;
1274     PetscScalar cvals[2];
1275 
1276     if (pcbddc->nedcG) {
1277       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1278     }
1279     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1280     if (Gins && GKins) {
1281       const PetscScalar *data;
1282       const PetscInt    *rows,*cols;
1283       PetscInt          nrh,nch,nrc,ncc;
1284 
1285       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1286       /* H1 */
1287       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1288       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1289       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1290       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1291       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1292       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1293       /* complement */
1294       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1295       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1296       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);
1297       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);
1298       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1299       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1300       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1301 
1302       /* coarse discrete gradient */
1303       if (pcbddc->nedcG) {
1304         PetscInt cols[2];
1305 
1306         cols[0] = 2*i;
1307         cols[1] = 2*i+1;
1308         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1309       }
1310       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1311     }
1312     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1314     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1315     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1316     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1317   }
1318   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1319 
1320   /* Start assembling */
1321   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1322   if (pcbddc->nedcG) {
1323     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1324   }
1325 
1326   /* Free */
1327   if (fl2g) {
1328     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1329     for (i=0;i<nee;i++) {
1330       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1331     }
1332     ierr = PetscFree(eedges);CHKERRQ(ierr);
1333   }
1334 
1335   /* hack mat_graph with primal dofs on the coarse edges */
1336   {
1337     PCBDDCGraph graph   = pcbddc->mat_graph;
1338     PetscInt    *oqueue = graph->queue;
1339     PetscInt    *ocptr  = graph->cptr;
1340     PetscInt    ncc,*idxs;
1341 
1342     /* find first primal edge */
1343     if (pcbddc->nedclocal) {
1344       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1345     } else {
1346       if (fl2g) {
1347         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1348       }
1349       idxs = cedges;
1350     }
1351     cum = 0;
1352     while (cum < nee && cedges[cum] < 0) cum++;
1353 
1354     /* adapt connected components */
1355     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1356     graph->cptr[0] = 0;
1357     for (i=0,ncc=0;i<graph->ncc;i++) {
1358       PetscInt lc = ocptr[i+1]-ocptr[i];
1359       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1360         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1361         graph->queue[graph->cptr[ncc]] = cedges[cum];
1362         ncc++;
1363         lc--;
1364         cum++;
1365         while (cum < nee && cedges[cum] < 0) cum++;
1366       }
1367       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1368       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1369       ncc++;
1370     }
1371     graph->ncc = ncc;
1372     if (pcbddc->nedclocal) {
1373       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1374     }
1375     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1376   }
1377   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1379   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1380   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1381 
1382   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1383   ierr = PetscFree(extrow);CHKERRQ(ierr);
1384   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1385   ierr = PetscFree(corners);CHKERRQ(ierr);
1386   ierr = PetscFree(cedges);CHKERRQ(ierr);
1387   ierr = PetscFree(extrows);CHKERRQ(ierr);
1388   ierr = PetscFree(extcols);CHKERRQ(ierr);
1389   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1390 
1391   /* Complete assembling */
1392   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1393   if (pcbddc->nedcG) {
1394     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1395 #if 0
1396     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1397     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1398 #endif
1399   }
1400 
1401   /* set change of basis */
1402   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1403   ierr = MatDestroy(&T);CHKERRQ(ierr);
1404 
1405   PetscFunctionReturn(0);
1406 }
1407 
1408 /* the near-null space of BDDC carries information on quadrature weights,
1409    and these can be collinear -> so cheat with MatNullSpaceCreate
1410    and create a suitable set of basis vectors first */
1411 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1412 {
1413   PetscErrorCode ierr;
1414   PetscInt       i;
1415 
1416   PetscFunctionBegin;
1417   for (i=0;i<nvecs;i++) {
1418     PetscInt first,last;
1419 
1420     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1421     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1422     if (i>=first && i < last) {
1423       PetscScalar *data;
1424       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1425       if (!has_const) {
1426         data[i-first] = 1.;
1427       } else {
1428         data[2*i-first] = 1./PetscSqrtReal(2.);
1429         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1430       }
1431       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1432     }
1433     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1434   }
1435   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1436   for (i=0;i<nvecs;i++) { /* reset vectors */
1437     PetscInt first,last;
1438     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1439     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1440     if (i>=first && i < last) {
1441       PetscScalar *data;
1442       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1443       if (!has_const) {
1444         data[i-first] = 0.;
1445       } else {
1446         data[2*i-first] = 0.;
1447         data[2*i-first+1] = 0.;
1448       }
1449       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1450     }
1451     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1452     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1453   }
1454   PetscFunctionReturn(0);
1455 }
1456 
1457 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1458 {
1459   Mat                    loc_divudotp;
1460   Vec                    p,v,vins,quad_vec,*quad_vecs;
1461   ISLocalToGlobalMapping map;
1462   PetscScalar            *vals;
1463   const PetscScalar      *array;
1464   PetscInt               i,maxneighs = 0,maxsize,*gidxs;
1465   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1466   PetscMPIInt            rank;
1467   PetscErrorCode         ierr;
1468 
1469   PetscFunctionBegin;
1470   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1471   for (i=0;i<n_neigh;i++) maxneighs = PetscMax(graph->count[shared[i][0]]+1,maxneighs);
1472   ierr = MPIU_Allreduce(MPI_IN_PLACE,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1473   if (!maxneighs) {
1474     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1475     *nnsp = NULL;
1476     PetscFunctionReturn(0);
1477   }
1478   maxsize = 0;
1479   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1480   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1481   /* create vectors to hold quadrature weights */
1482   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1483   if (!transpose) {
1484     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1485   } else {
1486     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1487   }
1488   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1489   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1490   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1491   for (i=0;i<maxneighs;i++) {
1492     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1493   }
1494 
1495   /* compute local quad vec */
1496   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1497   if (!transpose) {
1498     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1499   } else {
1500     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1501   }
1502   ierr = VecSet(p,1.);CHKERRQ(ierr);
1503   if (!transpose) {
1504     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1505   } else {
1506     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1507   }
1508   if (vl2l) {
1509     Mat        lA;
1510     VecScatter sc;
1511 
1512     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1513     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1514     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1515     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1517     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1518   } else {
1519     vins = v;
1520   }
1521   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1522   ierr = VecDestroy(&p);CHKERRQ(ierr);
1523 
1524   /* insert in global quadrature vecs */
1525   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1526   for (i=1;i<n_neigh;i++) {
1527     const PetscInt    *idxs;
1528     PetscInt          idx,nn,j;
1529 
1530     idxs = shared[i];
1531     nn   = n_shared[i];
1532     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1533     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1534     idx  = -(idx+1);
1535     if (idx < 0 || idx >= maxneighs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid index %D not in [0,%D)",idx,maxneighs);
1536     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1537     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1538   }
1539   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1540   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1541   if (vl2l) {
1542     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1543   }
1544   ierr = VecDestroy(&v);CHKERRQ(ierr);
1545   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1546 
1547   /* assemble near null space */
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1550   }
1551   for (i=0;i<maxneighs;i++) {
1552     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1553     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1554     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1555   }
1556   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   PetscFunctionReturn(0);
1558 }
1559 
1560 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1561 {
1562   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1563   PetscErrorCode ierr;
1564 
1565   PetscFunctionBegin;
1566   if (primalv) {
1567     if (pcbddc->user_primal_vertices_local) {
1568       IS list[2], newp;
1569 
1570       list[0] = primalv;
1571       list[1] = pcbddc->user_primal_vertices_local;
1572       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1573       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1574       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1575       pcbddc->user_primal_vertices_local = newp;
1576     } else {
1577       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1578     }
1579   }
1580   PetscFunctionReturn(0);
1581 }
1582 
1583 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1584 {
1585   PetscInt f, *comp  = (PetscInt *)ctx;
1586 
1587   PetscFunctionBegin;
1588   for (f=0;f<Nf;f++) out[f] = X[*comp];
1589   PetscFunctionReturn(0);
1590 }
1591 
1592 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1593 {
1594   PetscErrorCode ierr;
1595   Vec            local,global;
1596   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1597   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1598   PetscBool      monolithic = PETSC_FALSE;
1599 
1600   PetscFunctionBegin;
1601   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1602   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1603   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1604   /* need to convert from global to local topology information and remove references to information in global ordering */
1605   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1606   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1607   ierr = VecBindToCPU(global,PETSC_TRUE);CHKERRQ(ierr);
1608   ierr = VecBindToCPU(local,PETSC_TRUE);CHKERRQ(ierr);
1609   if (monolithic) { /* just get block size to properly compute vertices */
1610     if (pcbddc->vertex_size == 1) {
1611       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1612     }
1613     goto boundary;
1614   }
1615 
1616   if (pcbddc->user_provided_isfordofs) {
1617     if (pcbddc->n_ISForDofs) {
1618       PetscInt i;
1619 
1620       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1621       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1622         PetscInt bs;
1623 
1624         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1625         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1626         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1627         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1628       }
1629       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1630       pcbddc->n_ISForDofs = 0;
1631       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1632     }
1633   } else {
1634     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1635       DM dm;
1636 
1637       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1638       if (!dm) {
1639         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1640       }
1641       if (dm) {
1642         IS      *fields;
1643         PetscInt nf,i;
1644 
1645         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1646         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1647         for (i=0;i<nf;i++) {
1648           PetscInt bs;
1649 
1650           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1651           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1652           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1653           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1654         }
1655         ierr = PetscFree(fields);CHKERRQ(ierr);
1656         pcbddc->n_ISForDofsLocal = nf;
1657       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1658         PetscContainer   c;
1659 
1660         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1661         if (c) {
1662           MatISLocalFields lf;
1663           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1664           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1665         } else { /* fallback, create the default fields if bs > 1 */
1666           PetscInt i, n = matis->A->rmap->n;
1667           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1668           if (i > 1) {
1669             pcbddc->n_ISForDofsLocal = i;
1670             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1671             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1672               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1673             }
1674           }
1675         }
1676       }
1677     } else {
1678       PetscInt i;
1679       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1680         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1681       }
1682     }
1683   }
1684 
1685 boundary:
1686   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1687     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1688   } else if (pcbddc->DirichletBoundariesLocal) {
1689     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1690   }
1691   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1692     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1693   } else if (pcbddc->NeumannBoundariesLocal) {
1694     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1695   }
1696   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1697     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1698   }
1699   ierr = VecDestroy(&global);CHKERRQ(ierr);
1700   ierr = VecDestroy(&local);CHKERRQ(ierr);
1701   /* detect local disconnected subdomains if requested (use matis->A) */
1702   if (pcbddc->detect_disconnected) {
1703     IS        primalv = NULL;
1704     PetscInt  i;
1705     PetscBool filter = pcbddc->detect_disconnected_filter;
1706 
1707     for (i=0;i<pcbddc->n_local_subs;i++) {
1708       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1709     }
1710     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1711     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1712     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1713     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1714   }
1715   /* early stage corner detection */
1716   {
1717     DM dm;
1718 
1719     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1720     if (!dm) {
1721       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1722     }
1723     if (dm) {
1724       PetscBool isda;
1725 
1726       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1727       if (isda) {
1728         ISLocalToGlobalMapping l2l;
1729         IS                     corners;
1730         Mat                    lA;
1731         PetscBool              gl,lo;
1732 
1733         {
1734           Vec               cvec;
1735           const PetscScalar *coords;
1736           PetscInt          dof,n,cdim;
1737           PetscBool         memc = PETSC_TRUE;
1738 
1739           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1740           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1741           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1742           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1743           n   /= cdim;
1744           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1745           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1746           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1747 #if defined(PETSC_USE_COMPLEX)
1748           memc = PETSC_FALSE;
1749 #endif
1750           if (dof != 1) memc = PETSC_FALSE;
1751           if (memc) {
1752             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1753           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1754             PetscReal *bcoords = pcbddc->mat_graph->coords;
1755             PetscInt  i, b, d;
1756 
1757             for (i=0;i<n;i++) {
1758               for (b=0;b<dof;b++) {
1759                 for (d=0;d<cdim;d++) {
1760                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1761                 }
1762               }
1763             }
1764           }
1765           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1766           pcbddc->mat_graph->cdim  = cdim;
1767           pcbddc->mat_graph->cnloc = dof*n;
1768           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1769         }
1770         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1771         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1772         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1773         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1774         lo   = (PetscBool)(l2l && corners);
1775         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1776         if (gl) { /* From PETSc's DMDA */
1777           const PetscInt    *idx;
1778           PetscInt          dof,bs,*idxout,n;
1779 
1780           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1781           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1782           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1783           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1784           if (bs == dof) {
1785             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1786             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1787           } else { /* the original DMDA local-to-local map have been modified */
1788             PetscInt i,d;
1789 
1790             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1791             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1792             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1793 
1794             bs = 1;
1795             n *= dof;
1796           }
1797           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1798           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1799           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1800           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1801           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1802           pcbddc->corner_selected  = PETSC_TRUE;
1803           pcbddc->corner_selection = PETSC_TRUE;
1804         }
1805         if (corners) {
1806           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1807         }
1808       }
1809     }
1810   }
1811   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1812     DM dm;
1813 
1814     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1815     if (!dm) {
1816       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1817     }
1818     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1819       Vec            vcoords;
1820       PetscSection   section;
1821       PetscReal      *coords;
1822       PetscInt       d,cdim,nl,nf,**ctxs;
1823       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1824 
1825       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1826       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1827       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1828       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1829       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1830       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1831       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1832       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1833       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1834       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1835       for (d=0;d<cdim;d++) {
1836         PetscInt          i;
1837         const PetscScalar *v;
1838 
1839         for (i=0;i<nf;i++) ctxs[i][0] = d;
1840         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1841         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1842         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1843         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1844       }
1845       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1846       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1847       ierr = PetscFree(coords);CHKERRQ(ierr);
1848       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1849       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1850     }
1851   }
1852   PetscFunctionReturn(0);
1853 }
1854 
1855 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1856 {
1857   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1858   PetscErrorCode  ierr;
1859   IS              nis;
1860   const PetscInt  *idxs;
1861   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1862   PetscBool       *ld;
1863 
1864   PetscFunctionBegin;
1865   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1866   if (mop == MPI_LAND) {
1867     /* init rootdata with true */
1868     ld   = (PetscBool*) matis->sf_rootdata;
1869     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1870   } else {
1871     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1872   }
1873   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1874   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1875   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1876   ld   = (PetscBool*) matis->sf_leafdata;
1877   for (i=0;i<nd;i++)
1878     if (-1 < idxs[i] && idxs[i] < n)
1879       ld[idxs[i]] = PETSC_TRUE;
1880   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1881   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1882   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1883   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1884   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1885   if (mop == MPI_LAND) {
1886     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1887   } else {
1888     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1889   }
1890   for (i=0,nnd=0;i<n;i++)
1891     if (ld[i])
1892       nidxs[nnd++] = i;
1893   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1894   ierr = ISDestroy(is);CHKERRQ(ierr);
1895   *is  = nis;
1896   PetscFunctionReturn(0);
1897 }
1898 
1899 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1900 {
1901   PC_IS             *pcis = (PC_IS*)(pc->data);
1902   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1903   PetscErrorCode    ierr;
1904 
1905   PetscFunctionBegin;
1906   if (!pcbddc->benign_have_null) {
1907     PetscFunctionReturn(0);
1908   }
1909   if (pcbddc->ChangeOfBasisMatrix) {
1910     Vec swap;
1911 
1912     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1913     swap = pcbddc->work_change;
1914     pcbddc->work_change = r;
1915     r = swap;
1916   }
1917   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1918   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1919   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1920   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1921   ierr = VecSet(z,0.);CHKERRQ(ierr);
1922   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1923   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1924   if (pcbddc->ChangeOfBasisMatrix) {
1925     pcbddc->work_change = r;
1926     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1927     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1928   }
1929   PetscFunctionReturn(0);
1930 }
1931 
1932 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1933 {
1934   PCBDDCBenignMatMult_ctx ctx;
1935   PetscErrorCode          ierr;
1936   PetscBool               apply_right,apply_left,reset_x;
1937 
1938   PetscFunctionBegin;
1939   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1940   if (transpose) {
1941     apply_right = ctx->apply_left;
1942     apply_left = ctx->apply_right;
1943   } else {
1944     apply_right = ctx->apply_right;
1945     apply_left = ctx->apply_left;
1946   }
1947   reset_x = PETSC_FALSE;
1948   if (apply_right) {
1949     const PetscScalar *ax;
1950     PetscInt          nl,i;
1951 
1952     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1953     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1954     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1955     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1956     for (i=0;i<ctx->benign_n;i++) {
1957       PetscScalar    sum,val;
1958       const PetscInt *idxs;
1959       PetscInt       nz,j;
1960       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1961       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1962       sum = 0.;
1963       if (ctx->apply_p0) {
1964         val = ctx->work[idxs[nz-1]];
1965         for (j=0;j<nz-1;j++) {
1966           sum += ctx->work[idxs[j]];
1967           ctx->work[idxs[j]] += val;
1968         }
1969       } else {
1970         for (j=0;j<nz-1;j++) {
1971           sum += ctx->work[idxs[j]];
1972         }
1973       }
1974       ctx->work[idxs[nz-1]] -= sum;
1975       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1976     }
1977     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1978     reset_x = PETSC_TRUE;
1979   }
1980   if (transpose) {
1981     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1982   } else {
1983     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1984   }
1985   if (reset_x) {
1986     ierr = VecResetArray(x);CHKERRQ(ierr);
1987   }
1988   if (apply_left) {
1989     PetscScalar *ay;
1990     PetscInt    i;
1991 
1992     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1993     for (i=0;i<ctx->benign_n;i++) {
1994       PetscScalar    sum,val;
1995       const PetscInt *idxs;
1996       PetscInt       nz,j;
1997       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1998       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1999       val = -ay[idxs[nz-1]];
2000       if (ctx->apply_p0) {
2001         sum = 0.;
2002         for (j=0;j<nz-1;j++) {
2003           sum += ay[idxs[j]];
2004           ay[idxs[j]] += val;
2005         }
2006         ay[idxs[nz-1]] += sum;
2007       } else {
2008         for (j=0;j<nz-1;j++) {
2009           ay[idxs[j]] += val;
2010         }
2011         ay[idxs[nz-1]] = 0.;
2012       }
2013       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2014     }
2015     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2016   }
2017   PetscFunctionReturn(0);
2018 }
2019 
2020 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2021 {
2022   PetscErrorCode ierr;
2023 
2024   PetscFunctionBegin;
2025   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2026   PetscFunctionReturn(0);
2027 }
2028 
2029 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2030 {
2031   PetscErrorCode ierr;
2032 
2033   PetscFunctionBegin;
2034   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2035   PetscFunctionReturn(0);
2036 }
2037 
2038 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2039 {
2040   PC_IS                   *pcis = (PC_IS*)pc->data;
2041   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2042   PCBDDCBenignMatMult_ctx ctx;
2043   PetscErrorCode          ierr;
2044 
2045   PetscFunctionBegin;
2046   if (!restore) {
2047     Mat                A_IB,A_BI;
2048     PetscScalar        *work;
2049     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2050 
2051     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2052     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2053     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2054     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2055     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2056     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2057     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2058     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2059     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2060     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2061     ctx->apply_left = PETSC_TRUE;
2062     ctx->apply_right = PETSC_FALSE;
2063     ctx->apply_p0 = PETSC_FALSE;
2064     ctx->benign_n = pcbddc->benign_n;
2065     if (reuse) {
2066       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2067       ctx->free = PETSC_FALSE;
2068     } else { /* TODO: could be optimized for successive solves */
2069       ISLocalToGlobalMapping N_to_D;
2070       PetscInt               i;
2071 
2072       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2073       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2074       for (i=0;i<pcbddc->benign_n;i++) {
2075         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2076       }
2077       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2078       ctx->free = PETSC_TRUE;
2079     }
2080     ctx->A = pcis->A_IB;
2081     ctx->work = work;
2082     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2083     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2084     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2085     pcis->A_IB = A_IB;
2086 
2087     /* A_BI as A_IB^T */
2088     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2089     pcbddc->benign_original_mat = pcis->A_BI;
2090     pcis->A_BI = A_BI;
2091   } else {
2092     if (!pcbddc->benign_original_mat) {
2093       PetscFunctionReturn(0);
2094     }
2095     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2096     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2097     pcis->A_IB = ctx->A;
2098     ctx->A = NULL;
2099     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2100     pcis->A_BI = pcbddc->benign_original_mat;
2101     pcbddc->benign_original_mat = NULL;
2102     if (ctx->free) {
2103       PetscInt i;
2104       for (i=0;i<ctx->benign_n;i++) {
2105         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2106       }
2107       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2108     }
2109     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2110     ierr = PetscFree(ctx);CHKERRQ(ierr);
2111   }
2112   PetscFunctionReturn(0);
2113 }
2114 
2115 /* used just in bddc debug mode */
2116 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2117 {
2118   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2119   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2120   Mat            An;
2121   PetscErrorCode ierr;
2122 
2123   PetscFunctionBegin;
2124   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2125   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2126   if (is1) {
2127     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2128     ierr = MatDestroy(&An);CHKERRQ(ierr);
2129   } else {
2130     *B = An;
2131   }
2132   PetscFunctionReturn(0);
2133 }
2134 
2135 /* TODO: add reuse flag */
2136 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2137 {
2138   Mat            Bt;
2139   PetscScalar    *a,*bdata;
2140   const PetscInt *ii,*ij;
2141   PetscInt       m,n,i,nnz,*bii,*bij;
2142   PetscBool      flg_row;
2143   PetscErrorCode ierr;
2144 
2145   PetscFunctionBegin;
2146   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2147   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2148   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2149   nnz = n;
2150   for (i=0;i<ii[n];i++) {
2151     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2152   }
2153   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2154   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2155   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2156   nnz = 0;
2157   bii[0] = 0;
2158   for (i=0;i<n;i++) {
2159     PetscInt j;
2160     for (j=ii[i];j<ii[i+1];j++) {
2161       PetscScalar entry = a[j];
2162       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2163         bij[nnz] = ij[j];
2164         bdata[nnz] = entry;
2165         nnz++;
2166       }
2167     }
2168     bii[i+1] = nnz;
2169   }
2170   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2171   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2172   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2173   {
2174     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2175     b->free_a = PETSC_TRUE;
2176     b->free_ij = PETSC_TRUE;
2177   }
2178   if (*B == A) {
2179     ierr = MatDestroy(&A);CHKERRQ(ierr);
2180   }
2181   *B = Bt;
2182   PetscFunctionReturn(0);
2183 }
2184 
2185 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2186 {
2187   Mat                    B = NULL;
2188   DM                     dm;
2189   IS                     is_dummy,*cc_n;
2190   ISLocalToGlobalMapping l2gmap_dummy;
2191   PCBDDCGraph            graph;
2192   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2193   PetscInt               i,n;
2194   PetscInt               *xadj,*adjncy;
2195   PetscBool              isplex = PETSC_FALSE;
2196   PetscErrorCode         ierr;
2197 
2198   PetscFunctionBegin;
2199   if (ncc) *ncc = 0;
2200   if (cc) *cc = NULL;
2201   if (primalv) *primalv = NULL;
2202   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2203   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2204   if (!dm) {
2205     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2206   }
2207   if (dm) {
2208     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2209   }
2210   if (filter) isplex = PETSC_FALSE;
2211 
2212   if (isplex) { /* this code has been modified from plexpartition.c */
2213     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2214     PetscInt      *adj = NULL;
2215     IS             cellNumbering;
2216     const PetscInt *cellNum;
2217     PetscBool      useCone, useClosure;
2218     PetscSection   section;
2219     PetscSegBuffer adjBuffer;
2220     PetscSF        sfPoint;
2221     PetscErrorCode ierr;
2222 
2223     PetscFunctionBegin;
2224     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2225     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2226     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2227     /* Build adjacency graph via a section/segbuffer */
2228     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2229     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2230     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2231     /* Always use FVM adjacency to create partitioner graph */
2232     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2233     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2234     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2235     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2236     for (n = 0, p = pStart; p < pEnd; p++) {
2237       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2238       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2239       adjSize = PETSC_DETERMINE;
2240       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2241       for (a = 0; a < adjSize; ++a) {
2242         const PetscInt point = adj[a];
2243         if (pStart <= point && point < pEnd) {
2244           PetscInt *PETSC_RESTRICT pBuf;
2245           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2246           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2247           *pBuf = point;
2248         }
2249       }
2250       n++;
2251     }
2252     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2253     /* Derive CSR graph from section/segbuffer */
2254     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2255     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2256     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2257     for (idx = 0, p = pStart; p < pEnd; p++) {
2258       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2259       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2260     }
2261     xadj[n] = size;
2262     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2263     /* Clean up */
2264     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2265     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2266     ierr = PetscFree(adj);CHKERRQ(ierr);
2267     graph->xadj = xadj;
2268     graph->adjncy = adjncy;
2269   } else {
2270     Mat       A;
2271     PetscBool isseqaij, flg_row;
2272 
2273     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2274     if (!A->rmap->N || !A->cmap->N) {
2275       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2276       PetscFunctionReturn(0);
2277     }
2278     ierr = PetscObjectBaseTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2279     if (!isseqaij && filter) {
2280       PetscBool isseqdense;
2281 
2282       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2283       if (!isseqdense) {
2284         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2285       } else { /* TODO: rectangular case and LDA */
2286         PetscScalar *array;
2287         PetscReal   chop=1.e-6;
2288 
2289         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2290         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2291         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2292         for (i=0;i<n;i++) {
2293           PetscInt j;
2294           for (j=i+1;j<n;j++) {
2295             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2296             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2297             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2298           }
2299         }
2300         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2301         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2302       }
2303     } else {
2304       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2305       B = A;
2306     }
2307     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2308 
2309     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2310     if (filter) {
2311       PetscScalar *data;
2312       PetscInt    j,cum;
2313 
2314       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2315       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2316       cum = 0;
2317       for (i=0;i<n;i++) {
2318         PetscInt t;
2319 
2320         for (j=xadj[i];j<xadj[i+1];j++) {
2321           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2322             continue;
2323           }
2324           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2325         }
2326         t = xadj_filtered[i];
2327         xadj_filtered[i] = cum;
2328         cum += t;
2329       }
2330       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2331       graph->xadj = xadj_filtered;
2332       graph->adjncy = adjncy_filtered;
2333     } else {
2334       graph->xadj = xadj;
2335       graph->adjncy = adjncy;
2336     }
2337   }
2338   /* compute local connected components using PCBDDCGraph */
2339   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2340   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2341   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2342   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2343   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2344   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2345   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2346 
2347   /* partial clean up */
2348   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2349   if (B) {
2350     PetscBool flg_row;
2351     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2352     ierr = MatDestroy(&B);CHKERRQ(ierr);
2353   }
2354   if (isplex) {
2355     ierr = PetscFree(xadj);CHKERRQ(ierr);
2356     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2357   }
2358 
2359   /* get back data */
2360   if (isplex) {
2361     if (ncc) *ncc = graph->ncc;
2362     if (cc || primalv) {
2363       Mat          A;
2364       PetscBT      btv,btvt;
2365       PetscSection subSection;
2366       PetscInt     *ids,cum,cump,*cids,*pids;
2367 
2368       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2369       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2370       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2371       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2372       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2373 
2374       cids[0] = 0;
2375       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2376         PetscInt j;
2377 
2378         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2379         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2380           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2381 
2382           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2383           for (k = 0; k < 2*size; k += 2) {
2384             PetscInt s, pp, p = closure[k], off, dof, cdof;
2385 
2386             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2387             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2388             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2389             for (s = 0; s < dof-cdof; s++) {
2390               if (PetscBTLookupSet(btvt,off+s)) continue;
2391               if (!PetscBTLookup(btv,off+s)) {
2392                 ids[cum++] = off+s;
2393               } else { /* cross-vertex */
2394                 pids[cump++] = off+s;
2395               }
2396             }
2397             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2398             if (pp != p) {
2399               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2400               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2401               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2402               for (s = 0; s < dof-cdof; s++) {
2403                 if (PetscBTLookupSet(btvt,off+s)) continue;
2404                 if (!PetscBTLookup(btv,off+s)) {
2405                   ids[cum++] = off+s;
2406                 } else { /* cross-vertex */
2407                   pids[cump++] = off+s;
2408                 }
2409               }
2410             }
2411           }
2412           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2413         }
2414         cids[i+1] = cum;
2415         /* mark dofs as already assigned */
2416         for (j = cids[i]; j < cids[i+1]; j++) {
2417           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2418         }
2419       }
2420       if (cc) {
2421         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2422         for (i = 0; i < graph->ncc; i++) {
2423           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2424         }
2425         *cc = cc_n;
2426       }
2427       if (primalv) {
2428         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2429       }
2430       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2431       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2432       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2433     }
2434   } else {
2435     if (ncc) *ncc = graph->ncc;
2436     if (cc) {
2437       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2438       for (i=0;i<graph->ncc;i++) {
2439         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);
2440       }
2441       *cc = cc_n;
2442     }
2443   }
2444   /* clean up graph */
2445   graph->xadj = NULL;
2446   graph->adjncy = NULL;
2447   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2448   PetscFunctionReturn(0);
2449 }
2450 
2451 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2452 {
2453   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2454   PC_IS*         pcis = (PC_IS*)(pc->data);
2455   IS             dirIS = NULL;
2456   PetscInt       i;
2457   PetscErrorCode ierr;
2458 
2459   PetscFunctionBegin;
2460   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2461   if (zerodiag) {
2462     Mat            A;
2463     Vec            vec3_N;
2464     PetscScalar    *vals;
2465     const PetscInt *idxs;
2466     PetscInt       nz,*count;
2467 
2468     /* p0 */
2469     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2470     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2471     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2472     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2473     for (i=0;i<nz;i++) vals[i] = 1.;
2474     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2475     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2476     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2477     /* v_I */
2478     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2479     for (i=0;i<nz;i++) vals[i] = 0.;
2480     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2481     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2482     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2483     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2484     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2485     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2486     if (dirIS) {
2487       PetscInt n;
2488 
2489       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2490       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2491       for (i=0;i<n;i++) vals[i] = 0.;
2492       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2493       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2494     }
2495     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2496     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2497     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2498     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2499     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2500     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2501     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2502     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]));
2503     ierr = PetscFree(vals);CHKERRQ(ierr);
2504     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2505 
2506     /* there should not be any pressure dofs lying on the interface */
2507     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2508     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2509     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2510     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2511     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2512     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]);
2513     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2514     ierr = PetscFree(count);CHKERRQ(ierr);
2515   }
2516   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2517 
2518   /* check PCBDDCBenignGetOrSetP0 */
2519   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2520   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2521   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2522   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2523   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2524   for (i=0;i<pcbddc->benign_n;i++) {
2525     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2526     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);
2527   }
2528   PetscFunctionReturn(0);
2529 }
2530 
2531 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2532 {
2533   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2534   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2535   PetscInt       nz,n,benign_n,bsp = 1;
2536   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2537   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2538   PetscErrorCode ierr;
2539 
2540   PetscFunctionBegin;
2541   if (reuse) goto project_b0;
2542   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2543   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2544   for (n=0;n<pcbddc->benign_n;n++) {
2545     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2546   }
2547   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2548   has_null_pressures = PETSC_TRUE;
2549   have_null = PETSC_TRUE;
2550   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2551      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2552      Checks if all the pressure dofs in each subdomain have a zero diagonal
2553      If not, a change of basis on pressures is not needed
2554      since the local Schur complements are already SPD
2555   */
2556   if (pcbddc->n_ISForDofsLocal) {
2557     IS        iP = NULL;
2558     PetscInt  p,*pp;
2559     PetscBool flg;
2560 
2561     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2562     n    = pcbddc->n_ISForDofsLocal;
2563     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2564     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2565     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2566     if (!flg) {
2567       n = 1;
2568       pp[0] = pcbddc->n_ISForDofsLocal-1;
2569     }
2570 
2571     bsp = 0;
2572     for (p=0;p<n;p++) {
2573       PetscInt bs;
2574 
2575       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]);
2576       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2577       bsp += bs;
2578     }
2579     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2580     bsp  = 0;
2581     for (p=0;p<n;p++) {
2582       const PetscInt *idxs;
2583       PetscInt       b,bs,npl,*bidxs;
2584 
2585       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2586       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2587       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2588       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2589       for (b=0;b<bs;b++) {
2590         PetscInt i;
2591 
2592         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2593         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2594         bsp++;
2595       }
2596       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2597       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2598     }
2599     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2600 
2601     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2602     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2603     if (iP) {
2604       IS newpressures;
2605 
2606       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2607       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2608       pressures = newpressures;
2609     }
2610     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2611     if (!sorted) {
2612       ierr = ISSort(pressures);CHKERRQ(ierr);
2613     }
2614     ierr = PetscFree(pp);CHKERRQ(ierr);
2615   }
2616 
2617   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2618   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2619   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2620   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2621   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2622   if (!sorted) {
2623     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2624   }
2625   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2626   zerodiag_save = zerodiag;
2627   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2628   if (!nz) {
2629     if (n) have_null = PETSC_FALSE;
2630     has_null_pressures = PETSC_FALSE;
2631     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2632   }
2633   recompute_zerodiag = PETSC_FALSE;
2634 
2635   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2636   zerodiag_subs    = NULL;
2637   benign_n         = 0;
2638   n_interior_dofs  = 0;
2639   interior_dofs    = NULL;
2640   nneu             = 0;
2641   if (pcbddc->NeumannBoundariesLocal) {
2642     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2643   }
2644   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2645   if (checkb) { /* need to compute interior nodes */
2646     PetscInt n,i,j;
2647     PetscInt n_neigh,*neigh,*n_shared,**shared;
2648     PetscInt *iwork;
2649 
2650     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2651     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2652     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2653     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2654     for (i=1;i<n_neigh;i++)
2655       for (j=0;j<n_shared[i];j++)
2656           iwork[shared[i][j]] += 1;
2657     for (i=0;i<n;i++)
2658       if (!iwork[i])
2659         interior_dofs[n_interior_dofs++] = i;
2660     ierr = PetscFree(iwork);CHKERRQ(ierr);
2661     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2662   }
2663   if (has_null_pressures) {
2664     IS             *subs;
2665     PetscInt       nsubs,i,j,nl;
2666     const PetscInt *idxs;
2667     PetscScalar    *array;
2668     Vec            *work;
2669     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2670 
2671     subs  = pcbddc->local_subs;
2672     nsubs = pcbddc->n_local_subs;
2673     /* 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) */
2674     if (checkb) {
2675       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2676       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2677       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2678       /* work[0] = 1_p */
2679       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2680       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2681       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2682       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2683       /* work[0] = 1_v */
2684       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2685       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2686       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2687       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2688       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2689     }
2690 
2691     if (nsubs > 1 || bsp > 1) {
2692       IS       *is;
2693       PetscInt b,totb;
2694 
2695       totb  = bsp;
2696       is    = bsp > 1 ? bzerodiag : &zerodiag;
2697       nsubs = PetscMax(nsubs,1);
2698       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2699       for (b=0;b<totb;b++) {
2700         for (i=0;i<nsubs;i++) {
2701           ISLocalToGlobalMapping l2g;
2702           IS                     t_zerodiag_subs;
2703           PetscInt               nl;
2704 
2705           if (subs) {
2706             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2707           } else {
2708             IS tis;
2709 
2710             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2711             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2712             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2713             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2714           }
2715           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2716           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2717           if (nl) {
2718             PetscBool valid = PETSC_TRUE;
2719 
2720             if (checkb) {
2721               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2722               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2723               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2724               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2725               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2726               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2727               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2728               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2729               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2730               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2731               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2732               for (j=0;j<n_interior_dofs;j++) {
2733                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2734                   valid = PETSC_FALSE;
2735                   break;
2736                 }
2737               }
2738               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2739             }
2740             if (valid && nneu) {
2741               const PetscInt *idxs;
2742               PetscInt       nzb;
2743 
2744               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2745               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2746               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2747               if (nzb) valid = PETSC_FALSE;
2748             }
2749             if (valid && pressures) {
2750               IS       t_pressure_subs,tmp;
2751               PetscInt i1,i2;
2752 
2753               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2754               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2755               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2756               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2757               if (i2 != i1) valid = PETSC_FALSE;
2758               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2759               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2760             }
2761             if (valid) {
2762               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2763               benign_n++;
2764             } else recompute_zerodiag = PETSC_TRUE;
2765           }
2766           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2767           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2768         }
2769       }
2770     } else { /* there's just one subdomain (or zero if they have not been detected */
2771       PetscBool valid = PETSC_TRUE;
2772 
2773       if (nneu) valid = PETSC_FALSE;
2774       if (valid && pressures) {
2775         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2776       }
2777       if (valid && checkb) {
2778         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2779         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2780         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2781         for (j=0;j<n_interior_dofs;j++) {
2782           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2783             valid = PETSC_FALSE;
2784             break;
2785           }
2786         }
2787         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2788       }
2789       if (valid) {
2790         benign_n = 1;
2791         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2792         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2793         zerodiag_subs[0] = zerodiag;
2794       }
2795     }
2796     if (checkb) {
2797       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2798     }
2799   }
2800   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2801 
2802   if (!benign_n) {
2803     PetscInt n;
2804 
2805     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2806     recompute_zerodiag = PETSC_FALSE;
2807     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2808     if (n) have_null = PETSC_FALSE;
2809   }
2810 
2811   /* final check for null pressures */
2812   if (zerodiag && pressures) {
2813     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2814   }
2815 
2816   if (recompute_zerodiag) {
2817     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2818     if (benign_n == 1) {
2819       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2820       zerodiag = zerodiag_subs[0];
2821     } else {
2822       PetscInt i,nzn,*new_idxs;
2823 
2824       nzn = 0;
2825       for (i=0;i<benign_n;i++) {
2826         PetscInt ns;
2827         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2828         nzn += ns;
2829       }
2830       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2831       nzn = 0;
2832       for (i=0;i<benign_n;i++) {
2833         PetscInt ns,*idxs;
2834         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2835         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2836         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2837         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2838         nzn += ns;
2839       }
2840       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2841       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2842     }
2843     have_null = PETSC_FALSE;
2844   }
2845 
2846   /* determines if the coarse solver will be singular or not */
2847   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2848 
2849   /* Prepare matrix to compute no-net-flux */
2850   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2851     Mat                    A,loc_divudotp;
2852     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2853     IS                     row,col,isused = NULL;
2854     PetscInt               M,N,n,st,n_isused;
2855 
2856     if (pressures) {
2857       isused = pressures;
2858     } else {
2859       isused = zerodiag_save;
2860     }
2861     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2862     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2863     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2864     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");
2865     n_isused = 0;
2866     if (isused) {
2867       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2868     }
2869     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2870     st = st-n_isused;
2871     if (n) {
2872       const PetscInt *gidxs;
2873 
2874       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2875       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2876       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2877       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2878       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2879       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2880     } else {
2881       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2882       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2883       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2884     }
2885     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2886     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2887     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2888     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2889     ierr = ISDestroy(&row);CHKERRQ(ierr);
2890     ierr = ISDestroy(&col);CHKERRQ(ierr);
2891     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2892     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2893     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2894     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2895     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2896     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2897     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2898     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2899     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2900     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2901   }
2902   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2903   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2904   if (bzerodiag) {
2905     PetscInt i;
2906 
2907     for (i=0;i<bsp;i++) {
2908       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2909     }
2910     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2911   }
2912   pcbddc->benign_n = benign_n;
2913   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2914 
2915   /* determines if the problem has subdomains with 0 pressure block */
2916   have_null = (PetscBool)(!!pcbddc->benign_n);
2917   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2918 
2919 project_b0:
2920   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2921   /* change of basis and p0 dofs */
2922   if (pcbddc->benign_n) {
2923     PetscInt i,s,*nnz;
2924 
2925     /* local change of basis for pressures */
2926     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2927     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2928     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2929     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2930     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2931     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2932     for (i=0;i<pcbddc->benign_n;i++) {
2933       const PetscInt *idxs;
2934       PetscInt       nzs,j;
2935 
2936       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2937       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2938       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2939       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2940       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2941     }
2942     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2943     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2944     ierr = PetscFree(nnz);CHKERRQ(ierr);
2945     /* set identity by default */
2946     for (i=0;i<n;i++) {
2947       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2948     }
2949     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2950     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2951     /* set change on pressures */
2952     for (s=0;s<pcbddc->benign_n;s++) {
2953       PetscScalar    *array;
2954       const PetscInt *idxs;
2955       PetscInt       nzs;
2956 
2957       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2958       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2959       for (i=0;i<nzs-1;i++) {
2960         PetscScalar vals[2];
2961         PetscInt    cols[2];
2962 
2963         cols[0] = idxs[i];
2964         cols[1] = idxs[nzs-1];
2965         vals[0] = 1.;
2966         vals[1] = 1.;
2967         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2968       }
2969       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2970       for (i=0;i<nzs-1;i++) array[i] = -1.;
2971       array[nzs-1] = 1.;
2972       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2973       /* store local idxs for p0 */
2974       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2975       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2976       ierr = PetscFree(array);CHKERRQ(ierr);
2977     }
2978     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2979     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2980 
2981     /* project if needed */
2982     if (pcbddc->benign_change_explicit) {
2983       Mat M;
2984 
2985       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2986       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2987       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2988       ierr = MatDestroy(&M);CHKERRQ(ierr);
2989     }
2990     /* store global idxs for p0 */
2991     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2992   }
2993   *zerodiaglocal = zerodiag;
2994   PetscFunctionReturn(0);
2995 }
2996 
2997 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2998 {
2999   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3000   PetscScalar    *array;
3001   PetscErrorCode ierr;
3002 
3003   PetscFunctionBegin;
3004   if (!pcbddc->benign_sf) {
3005     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3006     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3007   }
3008   if (get) {
3009     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3010     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3011     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3012     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3013   } else {
3014     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3015     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3016     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3017     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3018   }
3019   PetscFunctionReturn(0);
3020 }
3021 
3022 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3023 {
3024   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3025   PetscErrorCode ierr;
3026 
3027   PetscFunctionBegin;
3028   /* TODO: add error checking
3029     - avoid nested pop (or push) calls.
3030     - cannot push before pop.
3031     - cannot call this if pcbddc->local_mat is NULL
3032   */
3033   if (!pcbddc->benign_n) {
3034     PetscFunctionReturn(0);
3035   }
3036   if (pop) {
3037     if (pcbddc->benign_change_explicit) {
3038       IS       is_p0;
3039       MatReuse reuse;
3040 
3041       /* extract B_0 */
3042       reuse = MAT_INITIAL_MATRIX;
3043       if (pcbddc->benign_B0) {
3044         reuse = MAT_REUSE_MATRIX;
3045       }
3046       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3047       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3048       /* remove rows and cols from local problem */
3049       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3050       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3051       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3052       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3053     } else {
3054       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3055       PetscScalar *vals;
3056       PetscInt    i,n,*idxs_ins;
3057 
3058       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3059       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3060       if (!pcbddc->benign_B0) {
3061         PetscInt *nnz;
3062         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3063         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3064         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3065         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3066         for (i=0;i<pcbddc->benign_n;i++) {
3067           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3068           nnz[i] = n - nnz[i];
3069         }
3070         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3071         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3072         ierr = PetscFree(nnz);CHKERRQ(ierr);
3073       }
3074 
3075       for (i=0;i<pcbddc->benign_n;i++) {
3076         PetscScalar *array;
3077         PetscInt    *idxs,j,nz,cum;
3078 
3079         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3080         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3081         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3082         for (j=0;j<nz;j++) vals[j] = 1.;
3083         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3084         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3085         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3086         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3087         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3088         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3089         cum = 0;
3090         for (j=0;j<n;j++) {
3091           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3092             vals[cum] = array[j];
3093             idxs_ins[cum] = j;
3094             cum++;
3095           }
3096         }
3097         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3098         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3099         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3100       }
3101       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3102       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3103       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3104     }
3105   } else { /* push */
3106     if (pcbddc->benign_change_explicit) {
3107       PetscInt i;
3108 
3109       for (i=0;i<pcbddc->benign_n;i++) {
3110         PetscScalar *B0_vals;
3111         PetscInt    *B0_cols,B0_ncol;
3112 
3113         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3114         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3115         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3116         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3117         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3118       }
3119       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3120       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3121     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3122   }
3123   PetscFunctionReturn(0);
3124 }
3125 
3126 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3127 {
3128   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3129   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3130   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3131   PetscBLASInt    *B_iwork,*B_ifail;
3132   PetscScalar     *work,lwork;
3133   PetscScalar     *St,*S,*eigv;
3134   PetscScalar     *Sarray,*Starray;
3135   PetscReal       *eigs,thresh,lthresh,uthresh;
3136   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3137   PetscBool       allocated_S_St;
3138 #if defined(PETSC_USE_COMPLEX)
3139   PetscReal       *rwork;
3140 #endif
3141   PetscErrorCode  ierr;
3142 
3143   PetscFunctionBegin;
3144   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3145   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3146   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);
3147   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3148 
3149   if (pcbddc->dbg_flag) {
3150     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3151     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3152     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3153     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3154   }
3155 
3156   if (pcbddc->dbg_flag) {
3157     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);
3158   }
3159 
3160   /* max size of subsets */
3161   mss = 0;
3162   for (i=0;i<sub_schurs->n_subs;i++) {
3163     PetscInt subset_size;
3164 
3165     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3166     mss = PetscMax(mss,subset_size);
3167   }
3168 
3169   /* min/max and threshold */
3170   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3171   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3172   nmax = PetscMax(nmin,nmax);
3173   allocated_S_St = PETSC_FALSE;
3174   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3175     allocated_S_St = PETSC_TRUE;
3176   }
3177 
3178   /* allocate lapack workspace */
3179   cum = cum2 = 0;
3180   maxneigs = 0;
3181   for (i=0;i<sub_schurs->n_subs;i++) {
3182     PetscInt n,subset_size;
3183 
3184     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3185     n = PetscMin(subset_size,nmax);
3186     cum += subset_size;
3187     cum2 += subset_size*n;
3188     maxneigs = PetscMax(maxneigs,n);
3189   }
3190   lwork = 0;
3191   if (mss) {
3192     if (sub_schurs->is_symmetric) {
3193       PetscScalar  sdummy = 0.;
3194       PetscBLASInt B_itype = 1;
3195       PetscBLASInt B_N = mss, idummy = 0;
3196       PetscReal    rdummy = 0.,zero = 0.0;
3197       PetscReal    eps = 0.0; /* dlamch? */
3198 
3199       B_lwork = -1;
3200       /* some implementations may complain about NULL pointers, even if we are querying */
3201       S = &sdummy;
3202       St = &sdummy;
3203       eigs = &rdummy;
3204       eigv = &sdummy;
3205       B_iwork = &idummy;
3206       B_ifail = &idummy;
3207 #if defined(PETSC_USE_COMPLEX)
3208       rwork = &rdummy;
3209 #endif
3210       thresh = 1.0;
3211       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3212 #if defined(PETSC_USE_COMPLEX)
3213       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));
3214 #else
3215       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));
3216 #endif
3217       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3218       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3219     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3220   }
3221 
3222   nv = 0;
3223   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) */
3224     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3225   }
3226   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3227   if (allocated_S_St) {
3228     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3229   }
3230   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3231 #if defined(PETSC_USE_COMPLEX)
3232   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3233 #endif
3234   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3235                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3236                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3237                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3238                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3239   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3240 
3241   maxneigs = 0;
3242   cum = cumarray = 0;
3243   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3244   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3245   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3246     const PetscInt *idxs;
3247 
3248     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3249     for (cum=0;cum<nv;cum++) {
3250       pcbddc->adaptive_constraints_n[cum] = 1;
3251       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3252       pcbddc->adaptive_constraints_data[cum] = 1.0;
3253       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3254       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3255     }
3256     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3257   }
3258 
3259   if (mss) { /* multilevel */
3260     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3261     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3262   }
3263 
3264   lthresh = pcbddc->adaptive_threshold[0];
3265   uthresh = pcbddc->adaptive_threshold[1];
3266   for (i=0;i<sub_schurs->n_subs;i++) {
3267     const PetscInt *idxs;
3268     PetscReal      upper,lower;
3269     PetscInt       j,subset_size,eigs_start = 0;
3270     PetscBLASInt   B_N;
3271     PetscBool      same_data = PETSC_FALSE;
3272     PetscBool      scal = PETSC_FALSE;
3273 
3274     if (pcbddc->use_deluxe_scaling) {
3275       upper = PETSC_MAX_REAL;
3276       lower = uthresh;
3277     } else {
3278       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3279       upper = 1./uthresh;
3280       lower = 0.;
3281     }
3282     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3283     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3284     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3285     /* this is experimental: we assume the dofs have been properly grouped to have
3286        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3287     if (!sub_schurs->is_posdef) {
3288       Mat T;
3289 
3290       for (j=0;j<subset_size;j++) {
3291         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3292           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3293           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3294           ierr = MatDestroy(&T);CHKERRQ(ierr);
3295           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3296           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3297           ierr = MatDestroy(&T);CHKERRQ(ierr);
3298           if (sub_schurs->change_primal_sub) {
3299             PetscInt       nz,k;
3300             const PetscInt *idxs;
3301 
3302             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3303             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3304             for (k=0;k<nz;k++) {
3305               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3306               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3307             }
3308             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3309           }
3310           scal = PETSC_TRUE;
3311           break;
3312         }
3313       }
3314     }
3315 
3316     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3317       if (sub_schurs->is_symmetric) {
3318         PetscInt j,k;
3319         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3320           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3321           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3322         }
3323         for (j=0;j<subset_size;j++) {
3324           for (k=j;k<subset_size;k++) {
3325             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3326             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3327           }
3328         }
3329       } else {
3330         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3331         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3332       }
3333     } else {
3334       S = Sarray + cumarray;
3335       St = Starray + cumarray;
3336     }
3337     /* see if we can save some work */
3338     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3339       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3340     }
3341 
3342     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3343       B_neigs = 0;
3344     } else {
3345       if (sub_schurs->is_symmetric) {
3346         PetscBLASInt B_itype = 1;
3347         PetscBLASInt B_IL, B_IU;
3348         PetscReal    eps = -1.0; /* dlamch? */
3349         PetscInt     nmin_s;
3350         PetscBool    compute_range;
3351 
3352         B_neigs = 0;
3353         compute_range = (PetscBool)!same_data;
3354         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3355 
3356         if (pcbddc->dbg_flag) {
3357           PetscInt nc = 0;
3358 
3359           if (sub_schurs->change_primal_sub) {
3360             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3361           }
3362           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);
3363         }
3364 
3365         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3366         if (compute_range) {
3367 
3368           /* ask for eigenvalues larger than thresh */
3369           if (sub_schurs->is_posdef) {
3370 #if defined(PETSC_USE_COMPLEX)
3371             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));
3372 #else
3373             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));
3374 #endif
3375             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3376           } else { /* no theory so far, but it works nicely */
3377             PetscInt  recipe = 0,recipe_m = 1;
3378             PetscReal bb[2];
3379 
3380             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3381             switch (recipe) {
3382             case 0:
3383               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3384               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3385 #if defined(PETSC_USE_COMPLEX)
3386               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3387 #else
3388               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3389 #endif
3390               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3391               break;
3392             case 1:
3393               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3394 #if defined(PETSC_USE_COMPLEX)
3395               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));
3396 #else
3397               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));
3398 #endif
3399               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3400               if (!scal) {
3401                 PetscBLASInt B_neigs2 = 0;
3402 
3403                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3404                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3405                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3406 #if defined(PETSC_USE_COMPLEX)
3407                 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));
3408 #else
3409                 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));
3410 #endif
3411                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3412                 B_neigs += B_neigs2;
3413               }
3414               break;
3415             case 2:
3416               if (scal) {
3417                 bb[0] = PETSC_MIN_REAL;
3418                 bb[1] = 0;
3419 #if defined(PETSC_USE_COMPLEX)
3420                 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));
3421 #else
3422                 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));
3423 #endif
3424                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3425               } else {
3426                 PetscBLASInt B_neigs2 = 0;
3427                 PetscBool    import = PETSC_FALSE;
3428 
3429                 lthresh = PetscMax(lthresh,0.0);
3430                 if (lthresh > 0.0) {
3431                   bb[0] = PETSC_MIN_REAL;
3432                   bb[1] = lthresh*lthresh;
3433 
3434                   import = PETSC_TRUE;
3435 #if defined(PETSC_USE_COMPLEX)
3436                   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));
3437 #else
3438                   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));
3439 #endif
3440                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3441                 }
3442                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3443                 bb[1] = PETSC_MAX_REAL;
3444                 if (import) {
3445                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3446                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3447                 }
3448 #if defined(PETSC_USE_COMPLEX)
3449                 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));
3450 #else
3451                 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));
3452 #endif
3453                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3454                 B_neigs += B_neigs2;
3455               }
3456               break;
3457             case 3:
3458               if (scal) {
3459                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3460               } else {
3461                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3462               }
3463               if (!scal) {
3464                 bb[0] = uthresh;
3465                 bb[1] = PETSC_MAX_REAL;
3466 #if defined(PETSC_USE_COMPLEX)
3467                 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));
3468 #else
3469                 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));
3470 #endif
3471                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3472               }
3473               if (recipe_m > 0 && B_N - B_neigs > 0) {
3474                 PetscBLASInt B_neigs2 = 0;
3475 
3476                 B_IL = 1;
3477                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3478                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3479                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3480 #if defined(PETSC_USE_COMPLEX)
3481                 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));
3482 #else
3483                 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));
3484 #endif
3485                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3486                 B_neigs += B_neigs2;
3487               }
3488               break;
3489             case 4:
3490               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3491 #if defined(PETSC_USE_COMPLEX)
3492               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));
3493 #else
3494               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));
3495 #endif
3496               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3497               {
3498                 PetscBLASInt B_neigs2 = 0;
3499 
3500                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3501                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3502                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3503 #if defined(PETSC_USE_COMPLEX)
3504                 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));
3505 #else
3506                 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));
3507 #endif
3508                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3509                 B_neigs += B_neigs2;
3510               }
3511               break;
3512             case 5: /* same as before: first compute all eigenvalues, then filter */
3513 #if defined(PETSC_USE_COMPLEX)
3514               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));
3515 #else
3516               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));
3517 #endif
3518               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3519               {
3520                 PetscInt e,k,ne;
3521                 for (e=0,ne=0;e<B_neigs;e++) {
3522                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3523                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3524                     eigs[ne] = eigs[e];
3525                     ne++;
3526                   }
3527                 }
3528                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3529                 B_neigs = ne;
3530               }
3531               break;
3532             default:
3533               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3534               break;
3535             }
3536           }
3537         } else if (!same_data) { /* this is just to see all the eigenvalues */
3538           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3539           B_IL = 1;
3540 #if defined(PETSC_USE_COMPLEX)
3541           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));
3542 #else
3543           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3544 #endif
3545           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3546         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3547           PetscInt k;
3548           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3549           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3550           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3551           nmin = nmax;
3552           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3553           for (k=0;k<nmax;k++) {
3554             eigs[k] = 1./PETSC_SMALL;
3555             eigv[k*(subset_size+1)] = 1.0;
3556           }
3557         }
3558         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3559         if (B_ierr) {
3560           if (B_ierr < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3561           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);
3562           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);
3563         }
3564 
3565         if (B_neigs > nmax) {
3566           if (pcbddc->dbg_flag) {
3567             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3568           }
3569           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3570           B_neigs = nmax;
3571         }
3572 
3573         nmin_s = PetscMin(nmin,B_N);
3574         if (B_neigs < nmin_s) {
3575           PetscBLASInt B_neigs2 = 0;
3576 
3577           if (pcbddc->use_deluxe_scaling) {
3578             if (scal) {
3579               B_IU = nmin_s;
3580               B_IL = B_neigs + 1;
3581             } else {
3582               B_IL = B_N - nmin_s + 1;
3583               B_IU = B_N - B_neigs;
3584             }
3585           } else {
3586             B_IL = B_neigs + 1;
3587             B_IU = nmin_s;
3588           }
3589           if (pcbddc->dbg_flag) {
3590             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);
3591           }
3592           if (sub_schurs->is_symmetric) {
3593             PetscInt j,k;
3594             for (j=0;j<subset_size;j++) {
3595               for (k=j;k<subset_size;k++) {
3596                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3597                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3598               }
3599             }
3600           } else {
3601             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3602             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3603           }
3604           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3605 #if defined(PETSC_USE_COMPLEX)
3606           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));
3607 #else
3608           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));
3609 #endif
3610           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3611           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3612           B_neigs += B_neigs2;
3613         }
3614         if (B_ierr) {
3615           if (B_ierr < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3616           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);
3617           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);
3618         }
3619         if (pcbddc->dbg_flag) {
3620           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3621           for (j=0;j<B_neigs;j++) {
3622             if (eigs[j] == 0.0) {
3623               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3624             } else {
3625               if (pcbddc->use_deluxe_scaling) {
3626                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3627               } else {
3628                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3629               }
3630             }
3631           }
3632         }
3633       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3634     }
3635     /* change the basis back to the original one */
3636     if (sub_schurs->change) {
3637       Mat change,phi,phit;
3638 
3639       if (pcbddc->dbg_flag > 2) {
3640         PetscInt ii;
3641         for (ii=0;ii<B_neigs;ii++) {
3642           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3643           for (j=0;j<B_N;j++) {
3644 #if defined(PETSC_USE_COMPLEX)
3645             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3646             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3647             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3648 #else
3649             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3650 #endif
3651           }
3652         }
3653       }
3654       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3655       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3656       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3657       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3658       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3659       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3660     }
3661     maxneigs = PetscMax(B_neigs,maxneigs);
3662     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3663     if (B_neigs) {
3664       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3665 
3666       if (pcbddc->dbg_flag > 1) {
3667         PetscInt ii;
3668         for (ii=0;ii<B_neigs;ii++) {
3669           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3670           for (j=0;j<B_N;j++) {
3671 #if defined(PETSC_USE_COMPLEX)
3672             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3673             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3674             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3675 #else
3676             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3677 #endif
3678           }
3679         }
3680       }
3681       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3682       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3683       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3684       cum++;
3685     }
3686     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3687     /* shift for next computation */
3688     cumarray += subset_size*subset_size;
3689   }
3690   if (pcbddc->dbg_flag) {
3691     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3692   }
3693 
3694   if (mss) {
3695     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3696     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3697     /* destroy matrices (junk) */
3698     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3699     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3700   }
3701   if (allocated_S_St) {
3702     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3703   }
3704   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3705 #if defined(PETSC_USE_COMPLEX)
3706   ierr = PetscFree(rwork);CHKERRQ(ierr);
3707 #endif
3708   if (pcbddc->dbg_flag) {
3709     PetscInt maxneigs_r;
3710     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3711     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3712   }
3713   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3714   PetscFunctionReturn(0);
3715 }
3716 
3717 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3718 {
3719   PetscScalar    *coarse_submat_vals;
3720   PetscErrorCode ierr;
3721 
3722   PetscFunctionBegin;
3723   /* Setup local scatters R_to_B and (optionally) R_to_D */
3724   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3725   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3726 
3727   /* Setup local neumann solver ksp_R */
3728   /* PCBDDCSetUpLocalScatters should be called first! */
3729   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3730 
3731   /*
3732      Setup local correction and local part of coarse basis.
3733      Gives back the dense local part of the coarse matrix in column major ordering
3734   */
3735   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3736 
3737   /* Compute total number of coarse nodes and setup coarse solver */
3738   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3739 
3740   /* free */
3741   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3742   PetscFunctionReturn(0);
3743 }
3744 
3745 PetscErrorCode PCBDDCResetCustomization(PC pc)
3746 {
3747   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3748   PetscErrorCode ierr;
3749 
3750   PetscFunctionBegin;
3751   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3753   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3754   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3755   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3756   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3757   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3758   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3759   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3760   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3761   PetscFunctionReturn(0);
3762 }
3763 
3764 PetscErrorCode PCBDDCResetTopography(PC pc)
3765 {
3766   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3767   PetscInt       i;
3768   PetscErrorCode ierr;
3769 
3770   PetscFunctionBegin;
3771   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3772   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3773   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3774   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3775   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3776   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3777   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3778   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3779   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3780   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3781   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3782   for (i=0;i<pcbddc->n_local_subs;i++) {
3783     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3784   }
3785   pcbddc->n_local_subs = 0;
3786   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3787   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3788   pcbddc->graphanalyzed        = PETSC_FALSE;
3789   pcbddc->recompute_topography = PETSC_TRUE;
3790   pcbddc->corner_selected      = PETSC_FALSE;
3791   PetscFunctionReturn(0);
3792 }
3793 
3794 PetscErrorCode PCBDDCResetSolvers(PC pc)
3795 {
3796   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3797   PetscErrorCode ierr;
3798 
3799   PetscFunctionBegin;
3800   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3801   if (pcbddc->coarse_phi_B) {
3802     PetscScalar *array;
3803     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3804     ierr = PetscFree(array);CHKERRQ(ierr);
3805   }
3806   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3807   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3808   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3809   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3810   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3811   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3812   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3813   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3814   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3815   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3816   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3817   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3818   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3819   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3820   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3821   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3822   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3823   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3824   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3825   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3826   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3827   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3828   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3829   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3830   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3831   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3832   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3833   if (pcbddc->benign_zerodiag_subs) {
3834     PetscInt i;
3835     for (i=0;i<pcbddc->benign_n;i++) {
3836       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3837     }
3838     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3839   }
3840   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3841   PetscFunctionReturn(0);
3842 }
3843 
3844 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3845 {
3846   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3847   PC_IS          *pcis = (PC_IS*)pc->data;
3848   VecType        impVecType;
3849   PetscInt       n_constraints,n_R,old_size;
3850   PetscErrorCode ierr;
3851 
3852   PetscFunctionBegin;
3853   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3854   n_R = pcis->n - pcbddc->n_vertices;
3855   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3856   /* local work vectors (try to avoid unneeded work)*/
3857   /* R nodes */
3858   old_size = -1;
3859   if (pcbddc->vec1_R) {
3860     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3861   }
3862   if (n_R != old_size) {
3863     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3864     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3865     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3866     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3867     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3868     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3869   }
3870   /* local primal dofs */
3871   old_size = -1;
3872   if (pcbddc->vec1_P) {
3873     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3874   }
3875   if (pcbddc->local_primal_size != old_size) {
3876     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3877     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3878     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3879     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3880   }
3881   /* local explicit constraints */
3882   old_size = -1;
3883   if (pcbddc->vec1_C) {
3884     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3885   }
3886   if (n_constraints && n_constraints != old_size) {
3887     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3888     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3889     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3890     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3891   }
3892   PetscFunctionReturn(0);
3893 }
3894 
3895 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3896 {
3897   PetscErrorCode  ierr;
3898   /* pointers to pcis and pcbddc */
3899   PC_IS*          pcis = (PC_IS*)pc->data;
3900   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3901   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3902   /* submatrices of local problem */
3903   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3904   /* submatrices of local coarse problem */
3905   Mat             S_VV,S_CV,S_VC,S_CC;
3906   /* working matrices */
3907   Mat             C_CR;
3908   /* additional working stuff */
3909   PC              pc_R;
3910   Mat             F,Brhs = NULL;
3911   Vec             dummy_vec;
3912   PetscBool       isLU,isCHOL,need_benign_correction,sparserhs;
3913   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3914   PetscScalar     *work;
3915   PetscInt        *idx_V_B;
3916   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3917   PetscInt        i,n_R,n_D,n_B;
3918   PetscScalar     one=1.0,m_one=-1.0;
3919 
3920   PetscFunctionBegin;
3921   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");
3922   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3923 
3924   /* Set Non-overlapping dimensions */
3925   n_vertices = pcbddc->n_vertices;
3926   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3927   n_B = pcis->n_B;
3928   n_D = pcis->n - n_B;
3929   n_R = pcis->n - n_vertices;
3930 
3931   /* vertices in boundary numbering */
3932   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3933   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3934   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3935 
3936   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3937   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3938   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3939   ierr = MatDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3940   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3941   ierr = MatDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3942   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3943   ierr = MatDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3944   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3945   ierr = MatDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3946 
3947   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3948   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3949   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3950   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3951   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3952   lda_rhs = n_R;
3953   need_benign_correction = PETSC_FALSE;
3954   if (isLU || isCHOL) {
3955     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3956   } else if (sub_schurs && sub_schurs->reuse_solver) {
3957     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3958     MatFactorType      type;
3959 
3960     F = reuse_solver->F;
3961     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3962     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3963     if (type == MAT_FACTOR_LU) isLU = PETSC_TRUE;
3964     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3965     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3966   } else F = NULL;
3967 
3968   /* determine if we can use a sparse right-hand side */
3969   sparserhs = PETSC_FALSE;
3970   if (F) {
3971     MatSolverType solver;
3972 
3973     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3974     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3975   }
3976 
3977   /* allocate workspace */
3978   n = 0;
3979   if (n_constraints) {
3980     n += lda_rhs*n_constraints;
3981   }
3982   if (n_vertices) {
3983     n = PetscMax(2*lda_rhs*n_vertices,n);
3984     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3985   }
3986   if (!pcbddc->symmetric_primal) {
3987     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3988   }
3989   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3990 
3991   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3992   dummy_vec = NULL;
3993   if (need_benign_correction && lda_rhs != n_R && F) {
3994     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3995     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3996     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3997   }
3998 
3999   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4000   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4001 
4002   /* Precompute stuffs needed for preprocessing and application of BDDC*/
4003   if (n_constraints) {
4004     Mat         M3,C_B;
4005     IS          is_aux;
4006     PetscScalar *array,*array2;
4007 
4008     /* Extract constraints on R nodes: C_{CR}  */
4009     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4010     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4011     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4012 
4013     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4014     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4015     if (!sparserhs) {
4016       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4017       for (i=0;i<n_constraints;i++) {
4018         const PetscScalar *row_cmat_values;
4019         const PetscInt    *row_cmat_indices;
4020         PetscInt          size_of_constraint,j;
4021 
4022         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4023         for (j=0;j<size_of_constraint;j++) {
4024           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4025         }
4026         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4027       }
4028       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4029     } else {
4030       Mat tC_CR;
4031 
4032       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4033       if (lda_rhs != n_R) {
4034         PetscScalar *aa;
4035         PetscInt    r,*ii,*jj;
4036         PetscBool   done;
4037 
4038         ierr = MatGetRowIJ(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,"GetRowIJ failed");
4040         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4041         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4042         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4043         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4044       } else {
4045         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4046         tC_CR = C_CR;
4047       }
4048       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4049       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4050     }
4051     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4052     if (F) {
4053       if (need_benign_correction) {
4054         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4055 
4056         /* rhs is already zero on interior dofs, no need to change the rhs */
4057         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4058       }
4059       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4060       if (need_benign_correction) {
4061         PetscScalar        *marr;
4062         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4063 
4064         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4065         if (lda_rhs != n_R) {
4066           for (i=0;i<n_constraints;i++) {
4067             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4068             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4069             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4070           }
4071         } else {
4072           for (i=0;i<n_constraints;i++) {
4073             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4074             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4075             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4076           }
4077         }
4078         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4079       }
4080     } else {
4081       PetscScalar *marr;
4082 
4083       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4084       for (i=0;i<n_constraints;i++) {
4085         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4086         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4087         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4088         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4089         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4090         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4091       }
4092       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4093     }
4094     if (sparserhs) {
4095       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4096     }
4097     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4098     if (!pcbddc->switch_static) {
4099       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4100       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4101       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4102       for (i=0;i<n_constraints;i++) {
4103         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4104         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4105         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4106         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4107         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4108         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4109       }
4110       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4111       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4112       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4113     } else {
4114       if (lda_rhs != n_R) {
4115         IS dummy;
4116 
4117         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4118         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4119         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4120       } else {
4121         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4122         pcbddc->local_auxmat2 = local_auxmat2_R;
4123       }
4124       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4125     }
4126     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4127     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR})^{-1}  */
4128     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4129     if (isCHOL) {
4130       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4131     } else {
4132       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4133     }
4134     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4135     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4136     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4137     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4138     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4139     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4140   }
4141 
4142   /* Get submatrices from subdomain matrix */
4143   if (n_vertices) {
4144 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4145     PetscBool oldpin;
4146 #endif
4147     PetscBool isaij;
4148     IS        is_aux;
4149 
4150     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4151       IS tis;
4152 
4153       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4154       ierr = ISSort(tis);CHKERRQ(ierr);
4155       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4156       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4157     } else {
4158       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4159     }
4160 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4161     oldpin = pcbddc->local_mat->boundtocpu;
4162 #endif
4163     ierr = MatBindToCPU(pcbddc->local_mat,PETSC_TRUE);CHKERRQ(ierr);
4164     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4165     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4166     ierr = PetscObjectBaseTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isaij);CHKERRQ(ierr);
4167     if (!isaij) { /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4168       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4169     }
4170     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4171 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4172     ierr = MatBindToCPU(pcbddc->local_mat,oldpin);CHKERRQ(ierr);
4173 #endif
4174     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4175   }
4176 
4177   /* Matrix of coarse basis functions (local) */
4178   if (pcbddc->coarse_phi_B) {
4179     PetscInt on_B,on_primal,on_D=n_D;
4180     if (pcbddc->coarse_phi_D) {
4181       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4182     }
4183     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4184     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4185       PetscScalar *marray;
4186 
4187       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4188       ierr = PetscFree(marray);CHKERRQ(ierr);
4189       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4190       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4191       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4192       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4193     }
4194   }
4195 
4196   if (!pcbddc->coarse_phi_B) {
4197     PetscScalar *marr;
4198 
4199     /* memory size */
4200     n = n_B*pcbddc->local_primal_size;
4201     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4202     if (!pcbddc->symmetric_primal) n *= 2;
4203     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4204     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4205     marr += n_B*pcbddc->local_primal_size;
4206     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4207       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4208       marr += n_D*pcbddc->local_primal_size;
4209     }
4210     if (!pcbddc->symmetric_primal) {
4211       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4212       marr += n_B*pcbddc->local_primal_size;
4213       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4214         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4215       }
4216     } else {
4217       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4218       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4219       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4220         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4221         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4222       }
4223     }
4224   }
4225 
4226   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4227   p0_lidx_I = NULL;
4228   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4229     const PetscInt *idxs;
4230 
4231     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4232     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4233     for (i=0;i<pcbddc->benign_n;i++) {
4234       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4235     }
4236     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4237   }
4238 
4239   /* vertices */
4240   if (n_vertices) {
4241     PetscBool restoreavr = PETSC_FALSE;
4242 
4243     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4244 
4245     if (n_R) {
4246       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4247       PetscBLASInt      B_N,B_one = 1;
4248       const PetscScalar *x;
4249       PetscScalar       *y;
4250 
4251       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4252       if (need_benign_correction) {
4253         ISLocalToGlobalMapping RtoN;
4254         IS                     is_p0;
4255         PetscInt               *idxs_p0,n;
4256 
4257         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4258         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4259         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4260         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);
4261         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4262         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4263         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4264         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4265       }
4266 
4267       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4268       if (!sparserhs || need_benign_correction) {
4269         if (lda_rhs == n_R) {
4270           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4271         } else {
4272           PetscScalar    *av,*array;
4273           const PetscInt *xadj,*adjncy;
4274           PetscInt       n;
4275           PetscBool      flg_row;
4276 
4277           array = work+lda_rhs*n_vertices;
4278           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4279           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4280           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4281           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4282           for (i=0;i<n;i++) {
4283             PetscInt j;
4284             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4285           }
4286           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4287           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4288           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4289         }
4290         if (need_benign_correction) {
4291           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4292           PetscScalar        *marr;
4293 
4294           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4295           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4296 
4297                  | 0 0  0 | (V)
4298              L = | 0 0 -1 | (P-p0)
4299                  | 0 0 -1 | (p0)
4300 
4301           */
4302           for (i=0;i<reuse_solver->benign_n;i++) {
4303             const PetscScalar *vals;
4304             const PetscInt    *idxs,*idxs_zero;
4305             PetscInt          n,j,nz;
4306 
4307             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4308             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4309             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4310             for (j=0;j<n;j++) {
4311               PetscScalar val = vals[j];
4312               PetscInt    k,col = idxs[j];
4313               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4314             }
4315             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4316             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4317           }
4318           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4319         }
4320         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4321         Brhs = A_RV;
4322       } else {
4323         Mat tA_RVT,A_RVT;
4324 
4325         if (!pcbddc->symmetric_primal) {
4326           /* A_RV already scaled by -1 */
4327           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4328         } else {
4329           restoreavr = PETSC_TRUE;
4330           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4331           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4332           A_RVT = A_VR;
4333         }
4334         if (lda_rhs != n_R) {
4335           PetscScalar *aa;
4336           PetscInt    r,*ii,*jj;
4337           PetscBool   done;
4338 
4339           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4340           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4341           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4342           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4343           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4344           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4345         } else {
4346           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4347           tA_RVT = A_RVT;
4348         }
4349         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4350         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4351         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4352       }
4353       if (F) {
4354         /* need to correct the rhs */
4355         if (need_benign_correction) {
4356           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4357           PetscScalar        *marr;
4358 
4359           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4360           if (lda_rhs != n_R) {
4361             for (i=0;i<n_vertices;i++) {
4362               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4363               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4364               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4365             }
4366           } else {
4367             for (i=0;i<n_vertices;i++) {
4368               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4369               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4370               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4371             }
4372           }
4373           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4374         }
4375         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4376         if (restoreavr) {
4377           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4378         }
4379         /* need to correct the solution */
4380         if (need_benign_correction) {
4381           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4382           PetscScalar        *marr;
4383 
4384           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4385           if (lda_rhs != n_R) {
4386             for (i=0;i<n_vertices;i++) {
4387               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4388               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4389               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4390             }
4391           } else {
4392             for (i=0;i<n_vertices;i++) {
4393               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4394               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4395               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4396             }
4397           }
4398           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4399         }
4400       } else {
4401         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4402         for (i=0;i<n_vertices;i++) {
4403           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4404           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4405           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4406           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4407           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4408           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4409         }
4410         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4411       }
4412       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4413       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4414       /* S_VV and S_CV */
4415       if (n_constraints) {
4416         Mat B;
4417 
4418         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4419         for (i=0;i<n_vertices;i++) {
4420           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4421           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4422           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4423           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4424           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4425           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4426         }
4427         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4428         /* Reuse dense S_C = pcbddc->local_auxmat1 * B */
4429         ierr = MatProductCreateWithMat(pcbddc->local_auxmat1,B,NULL,S_CV);CHKERRQ(ierr);
4430         ierr = MatProductSetType(S_CV,MATPRODUCT_AB);CHKERRQ(ierr);
4431         ierr = MatProductSetFromOptions(S_CV);CHKERRQ(ierr);
4432         ierr = MatProductSymbolic(S_CV);CHKERRQ(ierr);
4433         ierr = MatProductNumeric(S_CV);CHKERRQ(ierr);
4434         ierr = MatProductClear(S_CV);CHKERRQ(ierr);
4435 
4436         ierr = MatDestroy(&B);CHKERRQ(ierr);
4437         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4438         /* Reuse B = local_auxmat2_R * S_CV */
4439         ierr = MatProductCreateWithMat(local_auxmat2_R,S_CV,NULL,B);CHKERRQ(ierr);
4440         ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4441         ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4442         ierr = MatProductSymbolic(B);CHKERRQ(ierr);
4443         ierr = MatProductNumeric(B);CHKERRQ(ierr);
4444 
4445         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4446         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4447         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4448         ierr = MatDestroy(&B);CHKERRQ(ierr);
4449       }
4450       if (lda_rhs != n_R) {
4451         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4452         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4453         ierr = MatDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4454       }
4455       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4456       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4457       if (need_benign_correction) {
4458         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4459         PetscScalar        *marr,*sums;
4460 
4461         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4462         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4463         for (i=0;i<reuse_solver->benign_n;i++) {
4464           const PetscScalar *vals;
4465           const PetscInt    *idxs,*idxs_zero;
4466           PetscInt          n,j,nz;
4467 
4468           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4469           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4470           for (j=0;j<n_vertices;j++) {
4471             PetscInt k;
4472             sums[j] = 0.;
4473             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4474           }
4475           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4476           for (j=0;j<n;j++) {
4477             PetscScalar val = vals[j];
4478             PetscInt k;
4479             for (k=0;k<n_vertices;k++) {
4480               marr[idxs[j]+k*n_vertices] += val*sums[k];
4481             }
4482           }
4483           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4484           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4485         }
4486         ierr = PetscFree(sums);CHKERRQ(ierr);
4487         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4488         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4489       }
4490       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4491       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4492       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4493       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4494       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4495       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4496       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4497       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4498       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4499     } else {
4500       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4501     }
4502     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4503 
4504     /* coarse basis functions */
4505     for (i=0;i<n_vertices;i++) {
4506       PetscScalar *y;
4507 
4508       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4509       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4510       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4511       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4512       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4513       y[n_B*i+idx_V_B[i]] = 1.0;
4514       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4515       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4516 
4517       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4518         PetscInt j;
4519 
4520         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4521         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4522         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4523         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4524         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4525         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4526         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4527       }
4528       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4529     }
4530     /* if n_R == 0 the object is not destroyed */
4531     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4532   }
4533   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4534 
4535   if (n_constraints) {
4536     Mat B;
4537 
4538     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4539     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4540     ierr = MatProductCreateWithMat(local_auxmat2_R,S_CC,NULL,B);CHKERRQ(ierr);
4541     ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4542     ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4543     ierr = MatProductSymbolic(B);CHKERRQ(ierr);
4544     ierr = MatProductNumeric(B);CHKERRQ(ierr);
4545 
4546     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4547     if (n_vertices) {
4548       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4549         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4550       } else {
4551         Mat S_VCt;
4552 
4553         if (lda_rhs != n_R) {
4554           ierr = MatDestroy(&B);CHKERRQ(ierr);
4555           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4556           ierr = MatDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4557         }
4558         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4559         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4560         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4561       }
4562     }
4563     ierr = MatDestroy(&B);CHKERRQ(ierr);
4564     /* coarse basis functions */
4565     for (i=0;i<n_constraints;i++) {
4566       PetscScalar *y;
4567 
4568       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4569       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4570       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4571       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4572       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4573       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4574       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4575       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4576         PetscInt j;
4577 
4578         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4579         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4580         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4581         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4582         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4583         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4584         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4585       }
4586       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4587     }
4588   }
4589   if (n_constraints) {
4590     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4591   }
4592   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4593 
4594   /* coarse matrix entries relative to B_0 */
4595   if (pcbddc->benign_n) {
4596     Mat               B0_B,B0_BPHI;
4597     IS                is_dummy;
4598     const PetscScalar *data;
4599     PetscInt          j;
4600 
4601     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4602     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4603     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4604     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4605     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4606     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4607     for (j=0;j<pcbddc->benign_n;j++) {
4608       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4609       for (i=0;i<pcbddc->local_primal_size;i++) {
4610         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4611         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4612       }
4613     }
4614     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4615     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4616     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4617   }
4618 
4619   /* compute other basis functions for non-symmetric problems */
4620   if (!pcbddc->symmetric_primal) {
4621     Mat         B_V=NULL,B_C=NULL;
4622     PetscScalar *marray;
4623 
4624     if (n_constraints) {
4625       Mat S_CCT,C_CRT;
4626 
4627       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4628       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4629       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4630       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4631       if (n_vertices) {
4632         Mat S_VCT;
4633 
4634         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4635         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4636         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4637       }
4638       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4639     } else {
4640       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4641     }
4642     if (n_vertices && n_R) {
4643       PetscScalar    *av,*marray;
4644       const PetscInt *xadj,*adjncy;
4645       PetscInt       n;
4646       PetscBool      flg_row;
4647 
4648       /* B_V = B_V - A_VR^T */
4649       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4650       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4651       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4652       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4653       for (i=0;i<n;i++) {
4654         PetscInt j;
4655         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4656       }
4657       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4658       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4659       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4660     }
4661 
4662     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4663     if (n_vertices) {
4664       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4665       for (i=0;i<n_vertices;i++) {
4666         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4667         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4668         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4669         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4670         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4671         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4672       }
4673       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4674     }
4675     if (B_C) {
4676       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4677       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4678         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4679         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4680         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4681         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4682         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4683         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4684       }
4685       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4686     }
4687     /* coarse basis functions */
4688     for (i=0;i<pcbddc->local_primal_size;i++) {
4689       PetscScalar *y;
4690 
4691       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4692       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4693       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4694       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4695       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4696       if (i<n_vertices) {
4697         y[n_B*i+idx_V_B[i]] = 1.0;
4698       }
4699       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4700       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4701 
4702       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4703         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4704         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4705         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4706         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4707         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4708         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4709       }
4710       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4711     }
4712     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4713     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4714   }
4715 
4716   /* free memory */
4717   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4718   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4719   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4720   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4721   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4722   ierr = PetscFree(work);CHKERRQ(ierr);
4723   if (n_vertices) {
4724     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4725   }
4726   if (n_constraints) {
4727     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4728   }
4729   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4730 
4731   /* Checking coarse_sub_mat and coarse basis functios */
4732   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4733   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4734   if (pcbddc->dbg_flag) {
4735     Mat         coarse_sub_mat;
4736     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4737     Mat         coarse_phi_D,coarse_phi_B;
4738     Mat         coarse_psi_D,coarse_psi_B;
4739     Mat         A_II,A_BB,A_IB,A_BI;
4740     Mat         C_B,CPHI;
4741     IS          is_dummy;
4742     Vec         mones;
4743     MatType     checkmattype=MATSEQAIJ;
4744     PetscReal   real_value;
4745 
4746     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4747       Mat A;
4748       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4749       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4750       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4751       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4752       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4753       ierr = MatDestroy(&A);CHKERRQ(ierr);
4754     } else {
4755       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4756       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4757       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4758       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4759     }
4760     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4761     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4762     if (!pcbddc->symmetric_primal) {
4763       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4764       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4765     }
4766     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4767 
4768     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4769     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4770     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4771     if (!pcbddc->symmetric_primal) {
4772       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4773       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4774       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4775       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4776       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4777       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4778       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4779       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4780       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4781       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4782       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4783       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4784     } else {
4785       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4786       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4787       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4788       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4789       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4790       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4791       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4792       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4793     }
4794     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4795     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4796     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4797     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4798     if (pcbddc->benign_n) {
4799       Mat               B0_B,B0_BPHI;
4800       const PetscScalar *data2;
4801       PetscScalar       *data;
4802       PetscInt          j;
4803 
4804       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4805       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4806       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4807       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4808       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4809       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4810       for (j=0;j<pcbddc->benign_n;j++) {
4811         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4812         for (i=0;i<pcbddc->local_primal_size;i++) {
4813           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4814           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4815         }
4816       }
4817       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4818       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4819       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4820       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4821       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4822     }
4823 #if 0
4824   {
4825     PetscViewer viewer;
4826     char filename[256];
4827     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4828     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4829     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4830     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4831     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4832     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4833     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4834     if (pcbddc->coarse_phi_B) {
4835       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4836       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4837     }
4838     if (pcbddc->coarse_phi_D) {
4839       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4840       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4841     }
4842     if (pcbddc->coarse_psi_B) {
4843       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4844       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4845     }
4846     if (pcbddc->coarse_psi_D) {
4847       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4848       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4849     }
4850     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4851     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4852     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4853     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4854     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4855     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4856     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4857     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4858     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4859     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4860     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4861   }
4862 #endif
4863     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4864     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4865     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4866     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4867 
4868     /* check constraints */
4869     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4870     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4871     if (!pcbddc->benign_n) { /* TODO: add benign case */
4872       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4873     } else {
4874       PetscScalar *data;
4875       Mat         tmat;
4876       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4877       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4878       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4879       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4880       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4881     }
4882     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4883     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4884     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4885     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4886     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4887     if (!pcbddc->symmetric_primal) {
4888       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4889       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4890       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4891       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4892       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4893     }
4894     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4895     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4896     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4897     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4898     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4899     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4900     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4901     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4902     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4903     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4904     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4905     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4906     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4907     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4908     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4909     if (!pcbddc->symmetric_primal) {
4910       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4911       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4912     }
4913     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4914   }
4915   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4916   {
4917     PetscBool gpu;
4918 
4919     ierr = PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu);CHKERRQ(ierr);
4920     if (gpu) {
4921       if (pcbddc->local_auxmat1) {
4922         ierr = MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4923       }
4924       if (pcbddc->local_auxmat2) {
4925         ierr = MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4926       }
4927       if (pcbddc->coarse_phi_B) {
4928         ierr = MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4929       }
4930       if (pcbddc->coarse_phi_D) {
4931         ierr = MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4932       }
4933       if (pcbddc->coarse_psi_B) {
4934         ierr = MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4935       }
4936       if (pcbddc->coarse_psi_D) {
4937         ierr = MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4938       }
4939     }
4940   }
4941   /* get back data */
4942   *coarse_submat_vals_n = coarse_submat_vals;
4943   PetscFunctionReturn(0);
4944 }
4945 
4946 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4947 {
4948   Mat            *work_mat;
4949   IS             isrow_s,iscol_s;
4950   PetscBool      rsorted,csorted;
4951   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4952   PetscErrorCode ierr;
4953 
4954   PetscFunctionBegin;
4955   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4956   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4957   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4958   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4959 
4960   if (!rsorted) {
4961     const PetscInt *idxs;
4962     PetscInt *idxs_sorted,i;
4963 
4964     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4965     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4966     for (i=0;i<rsize;i++) {
4967       idxs_perm_r[i] = i;
4968     }
4969     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4970     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4971     for (i=0;i<rsize;i++) {
4972       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4973     }
4974     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4975     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4976   } else {
4977     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4978     isrow_s = isrow;
4979   }
4980 
4981   if (!csorted) {
4982     if (isrow == iscol) {
4983       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4984       iscol_s = isrow_s;
4985     } else {
4986       const PetscInt *idxs;
4987       PetscInt       *idxs_sorted,i;
4988 
4989       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4990       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4991       for (i=0;i<csize;i++) {
4992         idxs_perm_c[i] = i;
4993       }
4994       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4995       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4996       for (i=0;i<csize;i++) {
4997         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4998       }
4999       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
5000       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
5001     }
5002   } else {
5003     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
5004     iscol_s = iscol;
5005   }
5006 
5007   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5008 
5009   if (!rsorted || !csorted) {
5010     Mat      new_mat;
5011     IS       is_perm_r,is_perm_c;
5012 
5013     if (!rsorted) {
5014       PetscInt *idxs_r,i;
5015       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
5016       for (i=0;i<rsize;i++) {
5017         idxs_r[idxs_perm_r[i]] = i;
5018       }
5019       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
5020       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
5021     } else {
5022       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
5023     }
5024     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
5025 
5026     if (!csorted) {
5027       if (isrow_s == iscol_s) {
5028         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
5029         is_perm_c = is_perm_r;
5030       } else {
5031         PetscInt *idxs_c,i;
5032         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5033         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
5034         for (i=0;i<csize;i++) {
5035           idxs_c[idxs_perm_c[i]] = i;
5036         }
5037         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
5038         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
5039       }
5040     } else {
5041       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
5042     }
5043     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
5044 
5045     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
5046     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
5047     work_mat[0] = new_mat;
5048     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
5049     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
5050   }
5051 
5052   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
5053   *B = work_mat[0];
5054   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
5055   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
5056   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5057   PetscFunctionReturn(0);
5058 }
5059 
5060 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5061 {
5062   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5063   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5064   Mat            new_mat,lA;
5065   IS             is_local,is_global;
5066   PetscInt       local_size;
5067   PetscBool      isseqaij;
5068   PetscErrorCode ierr;
5069 
5070   PetscFunctionBegin;
5071   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5072   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5073   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5074   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5075   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5076   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5077   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5078 
5079   if (pcbddc->dbg_flag) {
5080     Vec       x,x_change;
5081     PetscReal error;
5082 
5083     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5084     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5085     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5086     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5087     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5088     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5089     if (!pcbddc->change_interior) {
5090       const PetscScalar *x,*y,*v;
5091       PetscReal         lerror = 0.;
5092       PetscInt          i;
5093 
5094       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5095       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5096       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5097       for (i=0;i<local_size;i++)
5098         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5099           lerror = PetscAbsScalar(x[i]-y[i]);
5100       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5101       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5102       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5103       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5104       if (error > PETSC_SMALL) {
5105         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5106           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5107         } else {
5108           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5109         }
5110       }
5111     }
5112     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5113     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5114     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5115     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5116     if (error > PETSC_SMALL) {
5117       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5118         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5119       } else {
5120         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5121       }
5122     }
5123     ierr = VecDestroy(&x);CHKERRQ(ierr);
5124     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5125   }
5126 
5127   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5128   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5129 
5130   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5131   ierr = PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5132   if (isseqaij) {
5133     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5134     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5135     if (lA) {
5136       Mat work;
5137       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5138       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5139       ierr = MatDestroy(&work);CHKERRQ(ierr);
5140     }
5141   } else {
5142     Mat work_mat;
5143 
5144     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5145     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5146     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5147     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5148     if (lA) {
5149       Mat work;
5150       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5151       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5152       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5153       ierr = MatDestroy(&work);CHKERRQ(ierr);
5154     }
5155   }
5156   if (matis->A->symmetric_set) {
5157     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5158 #if !defined(PETSC_USE_COMPLEX)
5159     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5160 #endif
5161   }
5162   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5163   PetscFunctionReturn(0);
5164 }
5165 
5166 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5167 {
5168   PC_IS*          pcis = (PC_IS*)(pc->data);
5169   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5170   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5171   PetscInt        *idx_R_local=NULL;
5172   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5173   PetscInt        vbs,bs;
5174   PetscBT         bitmask=NULL;
5175   PetscErrorCode  ierr;
5176 
5177   PetscFunctionBegin;
5178   /*
5179     No need to setup local scatters if
5180       - primal space is unchanged
5181         AND
5182       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5183         AND
5184       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5185   */
5186   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5187     PetscFunctionReturn(0);
5188   }
5189   /* destroy old objects */
5190   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5191   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5192   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5193   /* Set Non-overlapping dimensions */
5194   n_B = pcis->n_B;
5195   n_D = pcis->n - n_B;
5196   n_vertices = pcbddc->n_vertices;
5197 
5198   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5199 
5200   /* create auxiliary bitmask and allocate workspace */
5201   if (!sub_schurs || !sub_schurs->reuse_solver) {
5202     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5203     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5204     for (i=0;i<n_vertices;i++) {
5205       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5206     }
5207 
5208     for (i=0, n_R=0; i<pcis->n; i++) {
5209       if (!PetscBTLookup(bitmask,i)) {
5210         idx_R_local[n_R++] = i;
5211       }
5212     }
5213   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5214     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5215 
5216     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5217     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5218   }
5219 
5220   /* Block code */
5221   vbs = 1;
5222   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5223   if (bs>1 && !(n_vertices%bs)) {
5224     PetscBool is_blocked = PETSC_TRUE;
5225     PetscInt  *vary;
5226     if (!sub_schurs || !sub_schurs->reuse_solver) {
5227       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5228       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5229       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5230       /* 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 */
5231       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5232       for (i=0; i<pcis->n/bs; i++) {
5233         if (vary[i]!=0 && vary[i]!=bs) {
5234           is_blocked = PETSC_FALSE;
5235           break;
5236         }
5237       }
5238       ierr = PetscFree(vary);CHKERRQ(ierr);
5239     } else {
5240       /* Verify directly the R set */
5241       for (i=0; i<n_R/bs; i++) {
5242         PetscInt j,node=idx_R_local[bs*i];
5243         for (j=1; j<bs; j++) {
5244           if (node != idx_R_local[bs*i+j]-j) {
5245             is_blocked = PETSC_FALSE;
5246             break;
5247           }
5248         }
5249       }
5250     }
5251     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5252       vbs = bs;
5253       for (i=0;i<n_R/vbs;i++) {
5254         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5255       }
5256     }
5257   }
5258   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5259   if (sub_schurs && sub_schurs->reuse_solver) {
5260     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5261 
5262     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5263     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5264     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5265     reuse_solver->is_R = pcbddc->is_R_local;
5266   } else {
5267     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5268   }
5269 
5270   /* print some info if requested */
5271   if (pcbddc->dbg_flag) {
5272     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5273     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5274     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5275     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5276     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5277     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);
5278     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5279   }
5280 
5281   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5282   if (!sub_schurs || !sub_schurs->reuse_solver) {
5283     IS       is_aux1,is_aux2;
5284     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5285 
5286     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5287     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5288     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5289     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5290     for (i=0; i<n_D; i++) {
5291       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5292     }
5293     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5294     for (i=0, j=0; i<n_R; i++) {
5295       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5296         aux_array1[j++] = i;
5297       }
5298     }
5299     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5300     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5301     for (i=0, j=0; i<n_B; i++) {
5302       if (!PetscBTLookup(bitmask,is_indices[i])) {
5303         aux_array2[j++] = i;
5304       }
5305     }
5306     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5307     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5308     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5309     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5310     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5311 
5312     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5313       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5314       for (i=0, j=0; i<n_R; i++) {
5315         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5316           aux_array1[j++] = i;
5317         }
5318       }
5319       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5320       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5321       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5322     }
5323     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5324     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5325   } else {
5326     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5327     IS                 tis;
5328     PetscInt           schur_size;
5329 
5330     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5331     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5332     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5333     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5334     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5335       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5336       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5337       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5338     }
5339   }
5340   PetscFunctionReturn(0);
5341 }
5342 
5343 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5344 {
5345   MatNullSpace   NullSpace;
5346   Mat            dmat;
5347   const Vec      *nullvecs;
5348   Vec            v,v2,*nullvecs2;
5349   VecScatter     sct = NULL;
5350   PetscContainer c;
5351   PetscScalar    *ddata;
5352   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5353   PetscBool      nnsp_has_cnst;
5354   PetscErrorCode ierr;
5355 
5356   PetscFunctionBegin;
5357   if (!is && !B) { /* MATIS */
5358     Mat_IS* matis = (Mat_IS*)A->data;
5359 
5360     if (!B) {
5361       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5362     }
5363     sct  = matis->cctx;
5364     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5365   } else {
5366     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5367     if (!NullSpace) {
5368       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5369     }
5370     if (NullSpace) PetscFunctionReturn(0);
5371   }
5372   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5373   if (!NullSpace) {
5374     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5375   }
5376   if (!NullSpace) PetscFunctionReturn(0);
5377 
5378   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5379   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5380   if (!sct) {
5381     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5382   }
5383   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5384   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5385   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5386   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5387   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5388   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5389   ierr = PetscMalloc1(n*bsiz,&ddata);CHKERRQ(ierr);
5390   for (k=0;k<nnsp_size;k++) {
5391     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]);CHKERRQ(ierr);
5392     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5393     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5394   }
5395   if (nnsp_has_cnst) {
5396     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5397     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5398   }
5399   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5400   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5401 
5402   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat);CHKERRQ(ierr);
5403   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)B),&c);CHKERRQ(ierr);
5404   ierr = PetscContainerSetPointer(c,ddata);CHKERRQ(ierr);
5405   ierr = PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault);CHKERRQ(ierr);
5406   ierr = PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c);CHKERRQ(ierr);
5407   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
5408   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5409   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5410 
5411   for (k=0;k<bsiz;k++) {
5412     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5413   }
5414   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5415   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5416   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5417   ierr = VecDestroy(&v);CHKERRQ(ierr);
5418   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5419   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5420   PetscFunctionReturn(0);
5421 }
5422 
5423 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5424 {
5425   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5426   PC_IS          *pcis = (PC_IS*)pc->data;
5427   PC             pc_temp;
5428   Mat            A_RR;
5429   MatNullSpace   nnsp;
5430   MatReuse       reuse;
5431   PetscScalar    m_one = -1.0;
5432   PetscReal      value;
5433   PetscInt       n_D,n_R;
5434   PetscBool      issbaij,opts;
5435   PetscErrorCode ierr;
5436   void           (*f)(void) = NULL;
5437   char           dir_prefix[256],neu_prefix[256],str_level[16];
5438   size_t         len;
5439 
5440   PetscFunctionBegin;
5441   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5442   /* approximate solver, propagate NearNullSpace if needed */
5443   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5444     MatNullSpace gnnsp1,gnnsp2;
5445     PetscBool    lhas,ghas;
5446 
5447     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5448     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5449     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5450     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5451     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5452     if (!ghas && (gnnsp1 || gnnsp2)) {
5453       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5454     }
5455   }
5456 
5457   /* compute prefixes */
5458   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5459   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5460   if (!pcbddc->current_level) {
5461     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5462     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5463     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5464     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5465   } else {
5466     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5467     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5468     len -= 15; /* remove "pc_bddc_coarse_" */
5469     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5470     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5471     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5472     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5473     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5474     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5475     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5476     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5477     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5478   }
5479 
5480   /* DIRICHLET PROBLEM */
5481   if (dirichlet) {
5482     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5483     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5484       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5485       if (pcbddc->dbg_flag) {
5486         Mat    A_IIn;
5487 
5488         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5489         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5490         pcis->A_II = A_IIn;
5491       }
5492     }
5493     if (pcbddc->local_mat->symmetric_set) {
5494       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5495     }
5496     /* Matrix for Dirichlet problem is pcis->A_II */
5497     n_D  = pcis->n - pcis->n_B;
5498     opts = PETSC_FALSE;
5499     if (!pcbddc->ksp_D) { /* create object if not yet build */
5500       opts = PETSC_TRUE;
5501       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5502       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5503       /* default */
5504       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5505       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5506       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5507       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5508       if (issbaij) {
5509         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5510       } else {
5511         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5512       }
5513       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5514     }
5515     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5516     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5517     /* Allow user's customization */
5518     if (opts) {
5519       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5520     }
5521     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5522     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5523       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5524     }
5525     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5526     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5527     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5528     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5529       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5530       const PetscInt *idxs;
5531       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5532 
5533       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5534       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5535       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5536       for (i=0;i<nl;i++) {
5537         for (d=0;d<cdim;d++) {
5538           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5539         }
5540       }
5541       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5542       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5543       ierr = PetscFree(scoords);CHKERRQ(ierr);
5544     }
5545     if (sub_schurs && sub_schurs->reuse_solver) {
5546       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5547 
5548       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5549     }
5550 
5551     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5552     if (!n_D) {
5553       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5554       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5555     }
5556     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5557     /* set ksp_D into pcis data */
5558     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5559     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5560     pcis->ksp_D = pcbddc->ksp_D;
5561   }
5562 
5563   /* NEUMANN PROBLEM */
5564   A_RR = NULL;
5565   if (neumann) {
5566     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5567     PetscInt        ibs,mbs;
5568     PetscBool       issbaij, reuse_neumann_solver;
5569     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5570 
5571     reuse_neumann_solver = PETSC_FALSE;
5572     if (sub_schurs && sub_schurs->reuse_solver) {
5573       IS iP;
5574 
5575       reuse_neumann_solver = PETSC_TRUE;
5576       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5577       if (iP) reuse_neumann_solver = PETSC_FALSE;
5578     }
5579     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5580     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5581     if (pcbddc->ksp_R) { /* already created ksp */
5582       PetscInt nn_R;
5583       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5584       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5585       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5586       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5587         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5588         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5589         reuse = MAT_INITIAL_MATRIX;
5590       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5591         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5592           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5593           reuse = MAT_INITIAL_MATRIX;
5594         } else { /* safe to reuse the matrix */
5595           reuse = MAT_REUSE_MATRIX;
5596         }
5597       }
5598       /* last check */
5599       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5600         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5601         reuse = MAT_INITIAL_MATRIX;
5602       }
5603     } else { /* first time, so we need to create the matrix */
5604       reuse = MAT_INITIAL_MATRIX;
5605     }
5606     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5607        TODO: Get Rid of these conversions */
5608     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5609     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5610     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5611     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5612       if (matis->A == pcbddc->local_mat) {
5613         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5614         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5615       } else {
5616         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5617       }
5618     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5619       if (matis->A == pcbddc->local_mat) {
5620         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5621         ierr = MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5622       } else {
5623         ierr = MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5624       }
5625     }
5626     /* extract A_RR */
5627     if (reuse_neumann_solver) {
5628       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5629 
5630       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5631         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5632         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5633           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5634         } else {
5635           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5636         }
5637       } else {
5638         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5639         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5640         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5641       }
5642     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5643       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5644     }
5645     if (pcbddc->local_mat->symmetric_set) {
5646       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5647     }
5648     opts = PETSC_FALSE;
5649     if (!pcbddc->ksp_R) { /* create object if not present */
5650       opts = PETSC_TRUE;
5651       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5652       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5653       /* default */
5654       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5655       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5656       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5657       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5658       if (issbaij) {
5659         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5660       } else {
5661         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5662       }
5663       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5664     }
5665     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5666     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5667     if (opts) { /* Allow user's customization once */
5668       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5669     }
5670     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5671     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5672       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5673     }
5674     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5675     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5676     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5677     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5678       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5679       const PetscInt *idxs;
5680       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5681 
5682       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5683       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5684       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5685       for (i=0;i<nl;i++) {
5686         for (d=0;d<cdim;d++) {
5687           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5688         }
5689       }
5690       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5691       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5692       ierr = PetscFree(scoords);CHKERRQ(ierr);
5693     }
5694 
5695     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5696     if (!n_R) {
5697       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5698       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5699     }
5700     /* Reuse solver if it is present */
5701     if (reuse_neumann_solver) {
5702       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5703 
5704       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5705     }
5706     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5707   }
5708 
5709   if (pcbddc->dbg_flag) {
5710     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5711     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5712     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5713   }
5714   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5715 
5716   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5717   if (pcbddc->NullSpace_corr[0]) {
5718     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5719   }
5720   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5721     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5722   }
5723   if (neumann && pcbddc->NullSpace_corr[2]) {
5724     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5725   }
5726   /* check Dirichlet and Neumann solvers */
5727   if (pcbddc->dbg_flag) {
5728     if (dirichlet) { /* Dirichlet */
5729       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5730       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5731       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5732       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5733       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5734       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5735       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);
5736       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5737     }
5738     if (neumann) { /* Neumann */
5739       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5740       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5741       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5742       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5743       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5744       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5745       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);
5746       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5747     }
5748   }
5749   /* free Neumann problem's matrix */
5750   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5751   PetscFunctionReturn(0);
5752 }
5753 
5754 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5755 {
5756   PetscErrorCode  ierr;
5757   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5758   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5759   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE) : PETSC_FALSE;
5760 
5761   PetscFunctionBegin;
5762   if (!reuse_solver) {
5763     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5764   }
5765   if (!pcbddc->switch_static) {
5766     if (applytranspose && pcbddc->local_auxmat1) {
5767       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5768       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5769     }
5770     if (!reuse_solver) {
5771       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5772       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5773     } else {
5774       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5775 
5776       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5777       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5778     }
5779   } else {
5780     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5781     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5782     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5783     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5784     if (applytranspose && pcbddc->local_auxmat1) {
5785       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5786       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5787       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5788       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5789     }
5790   }
5791   if (!reuse_solver || pcbddc->switch_static) {
5792     if (applytranspose) {
5793       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5794     } else {
5795       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5796     }
5797     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5798   } else {
5799     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5800 
5801     if (applytranspose) {
5802       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5803     } else {
5804       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5805     }
5806   }
5807   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5808   if (!pcbddc->switch_static) {
5809     if (!reuse_solver) {
5810       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5811       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5812     } else {
5813       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5814 
5815       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5816       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5817     }
5818     if (!applytranspose && pcbddc->local_auxmat1) {
5819       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5820       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5821     }
5822   } else {
5823     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5824     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5825     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5826     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5827     if (!applytranspose && pcbddc->local_auxmat1) {
5828       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5829       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5830     }
5831     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5832     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5833     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5834     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5835   }
5836   PetscFunctionReturn(0);
5837 }
5838 
5839 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5840 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5841 {
5842   PetscErrorCode ierr;
5843   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5844   PC_IS*            pcis = (PC_IS*)  (pc->data);
5845   const PetscScalar zero = 0.0;
5846 
5847   PetscFunctionBegin;
5848   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5849   if (!pcbddc->benign_apply_coarse_only) {
5850     if (applytranspose) {
5851       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5852       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5853     } else {
5854       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5855       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5856     }
5857   } else {
5858     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5859   }
5860 
5861   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5862   if (pcbddc->benign_n) {
5863     PetscScalar *array;
5864     PetscInt    j;
5865 
5866     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5867     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5868     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5869   }
5870 
5871   /* start communications from local primal nodes to rhs of coarse solver */
5872   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5873   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5874   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5875 
5876   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5877   if (pcbddc->coarse_ksp) {
5878     Mat          coarse_mat;
5879     Vec          rhs,sol;
5880     MatNullSpace nullsp;
5881     PetscBool    isbddc = PETSC_FALSE;
5882 
5883     if (pcbddc->benign_have_null) {
5884       PC        coarse_pc;
5885 
5886       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5887       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5888       /* we need to propagate to coarser levels the need for a possible benign correction */
5889       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5890         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5891         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5892         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5893       }
5894     }
5895     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5896     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5897     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5898     if (applytranspose) {
5899       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5900       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5901       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5902       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5903       if (nullsp) {
5904         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5905       }
5906     } else {
5907       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5908       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5909         PC        coarse_pc;
5910 
5911         if (nullsp) {
5912           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5913         }
5914         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5915         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5916         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5917         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5918       } else {
5919         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5920         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5921         if (nullsp) {
5922           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5923         }
5924       }
5925     }
5926     /* we don't need the benign correction at coarser levels anymore */
5927     if (pcbddc->benign_have_null && isbddc) {
5928       PC        coarse_pc;
5929       PC_BDDC*  coarsepcbddc;
5930 
5931       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5932       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5933       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5934       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5935     }
5936   }
5937 
5938   /* Local solution on R nodes */
5939   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5940     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5941   }
5942   /* communications from coarse sol to local primal nodes */
5943   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5944   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5945 
5946   /* Sum contributions from the two levels */
5947   if (!pcbddc->benign_apply_coarse_only) {
5948     if (applytranspose) {
5949       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5950       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5951     } else {
5952       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5953       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5954     }
5955     /* store p0 */
5956     if (pcbddc->benign_n) {
5957       PetscScalar *array;
5958       PetscInt    j;
5959 
5960       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5961       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5962       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5963     }
5964   } else { /* expand the coarse solution */
5965     if (applytranspose) {
5966       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5967     } else {
5968       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5969     }
5970   }
5971   PetscFunctionReturn(0);
5972 }
5973 
5974 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5975 {
5976   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5977   Vec               from,to;
5978   const PetscScalar *array;
5979   PetscErrorCode    ierr;
5980 
5981   PetscFunctionBegin;
5982   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5983     from = pcbddc->coarse_vec;
5984     to = pcbddc->vec1_P;
5985     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5986       Vec tvec;
5987 
5988       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5989       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5990       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5991       ierr = VecGetArrayRead(tvec,&array);CHKERRQ(ierr);
5992       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5993       ierr = VecRestoreArrayRead(tvec,&array);CHKERRQ(ierr);
5994     }
5995   } else { /* from local to global -> put data in coarse right hand side */
5996     from = pcbddc->vec1_P;
5997     to = pcbddc->coarse_vec;
5998   }
5999   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6000   PetscFunctionReturn(0);
6001 }
6002 
6003 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
6004 {
6005   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
6006   Vec               from,to;
6007   const PetscScalar *array;
6008   PetscErrorCode    ierr;
6009 
6010   PetscFunctionBegin;
6011   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
6012     from = pcbddc->coarse_vec;
6013     to = pcbddc->vec1_P;
6014   } else { /* from local to global -> put data in coarse right hand side */
6015     from = pcbddc->vec1_P;
6016     to = pcbddc->coarse_vec;
6017   }
6018   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6019   if (smode == SCATTER_FORWARD) {
6020     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
6021       Vec tvec;
6022 
6023       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6024       ierr = VecGetArrayRead(to,&array);CHKERRQ(ierr);
6025       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
6026       ierr = VecRestoreArrayRead(to,&array);CHKERRQ(ierr);
6027     }
6028   } else {
6029     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6030      ierr = VecResetArray(from);CHKERRQ(ierr);
6031     }
6032   }
6033   PetscFunctionReturn(0);
6034 }
6035 
6036 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6037 {
6038   PetscErrorCode    ierr;
6039   PC_IS*            pcis = (PC_IS*)(pc->data);
6040   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6041   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6042   /* one and zero */
6043   PetscScalar       one=1.0,zero=0.0;
6044   /* space to store constraints and their local indices */
6045   PetscScalar       *constraints_data;
6046   PetscInt          *constraints_idxs,*constraints_idxs_B;
6047   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6048   PetscInt          *constraints_n;
6049   /* iterators */
6050   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6051   /* BLAS integers */
6052   PetscBLASInt      lwork,lierr;
6053   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6054   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6055   /* reuse */
6056   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6057   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6058   /* change of basis */
6059   PetscBool         qr_needed;
6060   PetscBT           change_basis,qr_needed_idx;
6061   /* auxiliary stuff */
6062   PetscInt          *nnz,*is_indices;
6063   PetscInt          ncc;
6064   /* some quantities */
6065   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6066   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6067   PetscReal         tol; /* tolerance for retaining eigenmodes */
6068 
6069   PetscFunctionBegin;
6070   tol  = PetscSqrtReal(PETSC_SMALL);
6071   /* Destroy Mat objects computed previously */
6072   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6073   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6074   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6075   /* save info on constraints from previous setup (if any) */
6076   olocal_primal_size = pcbddc->local_primal_size;
6077   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6078   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6079   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6080   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6081   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6082   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6083 
6084   if (!pcbddc->adaptive_selection) {
6085     IS           ISForVertices,*ISForFaces,*ISForEdges;
6086     MatNullSpace nearnullsp;
6087     const Vec    *nearnullvecs;
6088     Vec          *localnearnullsp;
6089     PetscScalar  *array;
6090     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6091     PetscBool    nnsp_has_cnst;
6092     /* LAPACK working arrays for SVD or POD */
6093     PetscBool    skip_lapack,boolforchange;
6094     PetscScalar  *work;
6095     PetscReal    *singular_vals;
6096 #if defined(PETSC_USE_COMPLEX)
6097     PetscReal    *rwork;
6098 #endif
6099     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6100     PetscBLASInt dummy_int=1;
6101     PetscScalar  dummy_scalar=1.;
6102     PetscBool    use_pod = PETSC_FALSE;
6103 
6104     /* MKL SVD with same input gives different results on different processes! */
6105 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL)
6106     use_pod = PETSC_TRUE;
6107 #endif
6108     /* Get index sets for faces, edges and vertices from graph */
6109     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6110     /* print some info */
6111     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6112       PetscInt nv;
6113 
6114       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6115       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6116       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6117       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6118       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6119       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6120       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6121       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6122       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6123     }
6124 
6125     /* free unneeded index sets */
6126     if (!pcbddc->use_vertices) {
6127       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6128     }
6129     if (!pcbddc->use_edges) {
6130       for (i=0;i<n_ISForEdges;i++) {
6131         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6132       }
6133       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6134       n_ISForEdges = 0;
6135     }
6136     if (!pcbddc->use_faces) {
6137       for (i=0;i<n_ISForFaces;i++) {
6138         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6139       }
6140       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6141       n_ISForFaces = 0;
6142     }
6143 
6144     /* check if near null space is attached to global mat */
6145     if (pcbddc->use_nnsp) {
6146       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6147     } else nearnullsp = NULL;
6148 
6149     if (nearnullsp) {
6150       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6151       /* remove any stored info */
6152       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6153       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6154       /* store information for BDDC solver reuse */
6155       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6156       pcbddc->onearnullspace = nearnullsp;
6157       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6158       for (i=0;i<nnsp_size;i++) {
6159         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6160       }
6161     } else { /* if near null space is not provided BDDC uses constants by default */
6162       nnsp_size = 0;
6163       nnsp_has_cnst = PETSC_TRUE;
6164     }
6165     /* get max number of constraints on a single cc */
6166     max_constraints = nnsp_size;
6167     if (nnsp_has_cnst) max_constraints++;
6168 
6169     /*
6170          Evaluate maximum storage size needed by the procedure
6171          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6172          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6173          There can be multiple constraints per connected component
6174                                                                                                                                                            */
6175     n_vertices = 0;
6176     if (ISForVertices) {
6177       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6178     }
6179     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6180     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6181 
6182     total_counts = n_ISForFaces+n_ISForEdges;
6183     total_counts *= max_constraints;
6184     total_counts += n_vertices;
6185     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6186 
6187     total_counts = 0;
6188     max_size_of_constraint = 0;
6189     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6190       IS used_is;
6191       if (i<n_ISForEdges) {
6192         used_is = ISForEdges[i];
6193       } else {
6194         used_is = ISForFaces[i-n_ISForEdges];
6195       }
6196       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6197       total_counts += j;
6198       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6199     }
6200     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);
6201 
6202     /* get local part of global near null space vectors */
6203     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6204     for (k=0;k<nnsp_size;k++) {
6205       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6206       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6207       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6208     }
6209 
6210     /* whether or not to skip lapack calls */
6211     skip_lapack = PETSC_TRUE;
6212     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6213 
6214     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6215     if (!skip_lapack) {
6216       PetscScalar temp_work;
6217 
6218       if (use_pod) {
6219         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6220         ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6221         ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6222         ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6223 #if defined(PETSC_USE_COMPLEX)
6224         ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6225 #endif
6226         /* now we evaluate the optimal workspace using query with lwork=-1 */
6227         ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6228         ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6229         lwork = -1;
6230         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6231 #if !defined(PETSC_USE_COMPLEX)
6232         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6233 #else
6234         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6235 #endif
6236         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6237         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6238       } else {
6239 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6240         /* SVD */
6241         PetscInt max_n,min_n;
6242         max_n = max_size_of_constraint;
6243         min_n = max_constraints;
6244         if (max_size_of_constraint < max_constraints) {
6245           min_n = max_size_of_constraint;
6246           max_n = max_constraints;
6247         }
6248         ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6249 #if defined(PETSC_USE_COMPLEX)
6250         ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6251 #endif
6252         /* now we evaluate the optimal workspace using query with lwork=-1 */
6253         lwork = -1;
6254         ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6255         ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6256         ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6257         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6258 #if !defined(PETSC_USE_COMPLEX)
6259         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));
6260 #else
6261         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));
6262 #endif
6263         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6264         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6265 #else
6266         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6267 #endif /* on missing GESVD */
6268       }
6269       /* Allocate optimal workspace */
6270       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6271       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6272     }
6273     /* Now we can loop on constraining sets */
6274     total_counts = 0;
6275     constraints_idxs_ptr[0] = 0;
6276     constraints_data_ptr[0] = 0;
6277     /* vertices */
6278     if (n_vertices) {
6279       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6280       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6281       for (i=0;i<n_vertices;i++) {
6282         constraints_n[total_counts] = 1;
6283         constraints_data[total_counts] = 1.0;
6284         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6285         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6286         total_counts++;
6287       }
6288       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6289       n_vertices = total_counts;
6290     }
6291 
6292     /* edges and faces */
6293     total_counts_cc = total_counts;
6294     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6295       IS        used_is;
6296       PetscBool idxs_copied = PETSC_FALSE;
6297 
6298       if (ncc<n_ISForEdges) {
6299         used_is = ISForEdges[ncc];
6300         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6301       } else {
6302         used_is = ISForFaces[ncc-n_ISForEdges];
6303         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6304       }
6305       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6306 
6307       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6308       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6309       /* change of basis should not be performed on local periodic nodes */
6310       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6311       if (nnsp_has_cnst) {
6312         PetscScalar quad_value;
6313 
6314         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6315         idxs_copied = PETSC_TRUE;
6316 
6317         if (!pcbddc->use_nnsp_true) {
6318           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6319         } else {
6320           quad_value = 1.0;
6321         }
6322         for (j=0;j<size_of_constraint;j++) {
6323           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6324         }
6325         temp_constraints++;
6326         total_counts++;
6327       }
6328       for (k=0;k<nnsp_size;k++) {
6329         PetscReal real_value;
6330         PetscScalar *ptr_to_data;
6331 
6332         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6333         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6334         for (j=0;j<size_of_constraint;j++) {
6335           ptr_to_data[j] = array[is_indices[j]];
6336         }
6337         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6338         /* check if array is null on the connected component */
6339         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6340         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6341         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6342           temp_constraints++;
6343           total_counts++;
6344           if (!idxs_copied) {
6345             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6346             idxs_copied = PETSC_TRUE;
6347           }
6348         }
6349       }
6350       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6351       valid_constraints = temp_constraints;
6352       if (!pcbddc->use_nnsp_true && temp_constraints) {
6353         if (temp_constraints == 1) { /* just normalize the constraint */
6354           PetscScalar norm,*ptr_to_data;
6355 
6356           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6357           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6358           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6359           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6360           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6361         } else { /* perform SVD */
6362           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6363 
6364           if (use_pod) {
6365             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6366                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6367                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6368                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6369                   from that computed using LAPACKgesvd
6370                -> This is due to a different computation of eigenvectors in LAPACKheev
6371                -> The quality of the POD-computed basis will be the same */
6372             ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6373             /* Store upper triangular part of correlation matrix */
6374             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6375             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6376             for (j=0;j<temp_constraints;j++) {
6377               for (k=0;k<j+1;k++) {
6378                 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));
6379               }
6380             }
6381             /* compute eigenvalues and eigenvectors of correlation matrix */
6382             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6383             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6384 #if !defined(PETSC_USE_COMPLEX)
6385             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6386 #else
6387             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6388 #endif
6389             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6390             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6391             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6392             j = 0;
6393             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6394             total_counts = total_counts-j;
6395             valid_constraints = temp_constraints-j;
6396             /* scale and copy POD basis into used quadrature memory */
6397             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6398             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6399             ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6400             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6401             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6402             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6403             if (j<temp_constraints) {
6404               PetscInt ii;
6405               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6406               ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6407               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));
6408               ierr = PetscFPTrapPop();CHKERRQ(ierr);
6409               for (k=0;k<temp_constraints-j;k++) {
6410                 for (ii=0;ii<size_of_constraint;ii++) {
6411                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6412                 }
6413               }
6414             }
6415           } else {
6416 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6417             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6418             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6419             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6420             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6421 #if !defined(PETSC_USE_COMPLEX)
6422             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));
6423 #else
6424             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));
6425 #endif
6426             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6427             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6428             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6429             k = temp_constraints;
6430             if (k > size_of_constraint) k = size_of_constraint;
6431             j = 0;
6432             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6433             valid_constraints = k-j;
6434             total_counts = total_counts-temp_constraints+valid_constraints;
6435 #else
6436             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6437 #endif /* on missing GESVD */
6438           }
6439         }
6440       }
6441       /* update pointers information */
6442       if (valid_constraints) {
6443         constraints_n[total_counts_cc] = valid_constraints;
6444         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6445         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6446         /* set change_of_basis flag */
6447         if (boolforchange) {
6448           PetscBTSet(change_basis,total_counts_cc);
6449         }
6450         total_counts_cc++;
6451       }
6452     }
6453     /* free workspace */
6454     if (!skip_lapack) {
6455       ierr = PetscFree(work);CHKERRQ(ierr);
6456 #if defined(PETSC_USE_COMPLEX)
6457       ierr = PetscFree(rwork);CHKERRQ(ierr);
6458 #endif
6459       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6460       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6461       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6462     }
6463     for (k=0;k<nnsp_size;k++) {
6464       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6465     }
6466     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6467     /* free index sets of faces, edges and vertices */
6468     for (i=0;i<n_ISForFaces;i++) {
6469       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6470     }
6471     if (n_ISForFaces) {
6472       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6473     }
6474     for (i=0;i<n_ISForEdges;i++) {
6475       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6476     }
6477     if (n_ISForEdges) {
6478       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6479     }
6480     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6481   } else {
6482     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6483 
6484     total_counts = 0;
6485     n_vertices = 0;
6486     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6487       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6488     }
6489     max_constraints = 0;
6490     total_counts_cc = 0;
6491     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6492       total_counts += pcbddc->adaptive_constraints_n[i];
6493       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6494       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6495     }
6496     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6497     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6498     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6499     constraints_data = pcbddc->adaptive_constraints_data;
6500     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6501     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6502     total_counts_cc = 0;
6503     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6504       if (pcbddc->adaptive_constraints_n[i]) {
6505         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6506       }
6507     }
6508 
6509     max_size_of_constraint = 0;
6510     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]);
6511     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6512     /* Change of basis */
6513     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6514     if (pcbddc->use_change_of_basis) {
6515       for (i=0;i<sub_schurs->n_subs;i++) {
6516         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6517           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6518         }
6519       }
6520     }
6521   }
6522   pcbddc->local_primal_size = total_counts;
6523   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6524 
6525   /* map constraints_idxs in boundary numbering */
6526   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6527   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);
6528 
6529   /* Create constraint matrix */
6530   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6531   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6532   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6533 
6534   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6535   /* determine if a QR strategy is needed for change of basis */
6536   qr_needed = pcbddc->use_qr_single;
6537   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6538   total_primal_vertices=0;
6539   pcbddc->local_primal_size_cc = 0;
6540   for (i=0;i<total_counts_cc;i++) {
6541     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6542     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6543       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6544       pcbddc->local_primal_size_cc += 1;
6545     } else if (PetscBTLookup(change_basis,i)) {
6546       for (k=0;k<constraints_n[i];k++) {
6547         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6548       }
6549       pcbddc->local_primal_size_cc += constraints_n[i];
6550       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6551         PetscBTSet(qr_needed_idx,i);
6552         qr_needed = PETSC_TRUE;
6553       }
6554     } else {
6555       pcbddc->local_primal_size_cc += 1;
6556     }
6557   }
6558   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6559   pcbddc->n_vertices = total_primal_vertices;
6560   /* permute indices in order to have a sorted set of vertices */
6561   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6562   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);
6563   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6564   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6565 
6566   /* nonzero structure of constraint matrix */
6567   /* and get reference dof for local constraints */
6568   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6569   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6570 
6571   j = total_primal_vertices;
6572   total_counts = total_primal_vertices;
6573   cum = total_primal_vertices;
6574   for (i=n_vertices;i<total_counts_cc;i++) {
6575     if (!PetscBTLookup(change_basis,i)) {
6576       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6577       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6578       cum++;
6579       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6580       for (k=0;k<constraints_n[i];k++) {
6581         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6582         nnz[j+k] = size_of_constraint;
6583       }
6584       j += constraints_n[i];
6585     }
6586   }
6587   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6588   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6589   ierr = PetscFree(nnz);CHKERRQ(ierr);
6590 
6591   /* set values in constraint matrix */
6592   for (i=0;i<total_primal_vertices;i++) {
6593     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6594   }
6595   total_counts = total_primal_vertices;
6596   for (i=n_vertices;i<total_counts_cc;i++) {
6597     if (!PetscBTLookup(change_basis,i)) {
6598       PetscInt *cols;
6599 
6600       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6601       cols = constraints_idxs+constraints_idxs_ptr[i];
6602       for (k=0;k<constraints_n[i];k++) {
6603         PetscInt    row = total_counts+k;
6604         PetscScalar *vals;
6605 
6606         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6607         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6608       }
6609       total_counts += constraints_n[i];
6610     }
6611   }
6612   /* assembling */
6613   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6614   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6615   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6616 
6617   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6618   if (pcbddc->use_change_of_basis) {
6619     /* dual and primal dofs on a single cc */
6620     PetscInt     dual_dofs,primal_dofs;
6621     /* working stuff for GEQRF */
6622     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6623     PetscBLASInt lqr_work;
6624     /* working stuff for UNGQR */
6625     PetscScalar  *gqr_work = NULL,lgqr_work_t=0.0;
6626     PetscBLASInt lgqr_work;
6627     /* working stuff for TRTRS */
6628     PetscScalar  *trs_rhs = NULL;
6629     PetscBLASInt Blas_NRHS;
6630     /* pointers for values insertion into change of basis matrix */
6631     PetscInt     *start_rows,*start_cols;
6632     PetscScalar  *start_vals;
6633     /* working stuff for values insertion */
6634     PetscBT      is_primal;
6635     PetscInt     *aux_primal_numbering_B;
6636     /* matrix sizes */
6637     PetscInt     global_size,local_size;
6638     /* temporary change of basis */
6639     Mat          localChangeOfBasisMatrix;
6640     /* extra space for debugging */
6641     PetscScalar  *dbg_work = NULL;
6642 
6643     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6644     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6645     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6646     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6647     /* nonzeros for local mat */
6648     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6649     if (!pcbddc->benign_change || pcbddc->fake_change) {
6650       for (i=0;i<pcis->n;i++) nnz[i]=1;
6651     } else {
6652       const PetscInt *ii;
6653       PetscInt       n;
6654       PetscBool      flg_row;
6655       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6656       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6657       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6658     }
6659     for (i=n_vertices;i<total_counts_cc;i++) {
6660       if (PetscBTLookup(change_basis,i)) {
6661         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6662         if (PetscBTLookup(qr_needed_idx,i)) {
6663           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6664         } else {
6665           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6666           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6667         }
6668       }
6669     }
6670     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6671     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6672     ierr = PetscFree(nnz);CHKERRQ(ierr);
6673     /* Set interior change in the matrix */
6674     if (!pcbddc->benign_change || pcbddc->fake_change) {
6675       for (i=0;i<pcis->n;i++) {
6676         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6677       }
6678     } else {
6679       const PetscInt *ii,*jj;
6680       PetscScalar    *aa;
6681       PetscInt       n;
6682       PetscBool      flg_row;
6683       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6684       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6685       for (i=0;i<n;i++) {
6686         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6687       }
6688       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6689       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6690     }
6691 
6692     if (pcbddc->dbg_flag) {
6693       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6694       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6695     }
6696 
6697 
6698     /* Now we loop on the constraints which need a change of basis */
6699     /*
6700        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6701        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6702 
6703        Basic blocks of change of basis matrix T computed by
6704 
6705           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6706 
6707             | 1        0   ...        0         s_1/S |
6708             | 0        1   ...        0         s_2/S |
6709             |              ...                        |
6710             | 0        ...            1     s_{n-1}/S |
6711             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6712 
6713             with S = \sum_{i=1}^n s_i^2
6714             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6715                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6716 
6717           - QR decomposition of constraints otherwise
6718     */
6719     if (qr_needed && max_size_of_constraint) {
6720       /* space to store Q */
6721       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6722       /* array to store scaling factors for reflectors */
6723       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6724       /* first we issue queries for optimal work */
6725       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6726       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6727       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6728       lqr_work = -1;
6729       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6730       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6731       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6732       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6733       lgqr_work = -1;
6734       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6735       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6736       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6737       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6738       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6739       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6740       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6741       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6742       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6743       /* array to store rhs and solution of triangular solver */
6744       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6745       /* allocating workspace for check */
6746       if (pcbddc->dbg_flag) {
6747         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6748       }
6749     }
6750     /* array to store whether a node is primal or not */
6751     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6752     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6753     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6754     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);
6755     for (i=0;i<total_primal_vertices;i++) {
6756       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6757     }
6758     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6759 
6760     /* loop on constraints and see whether or not they need a change of basis and compute it */
6761     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6762       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6763       if (PetscBTLookup(change_basis,total_counts)) {
6764         /* get constraint info */
6765         primal_dofs = constraints_n[total_counts];
6766         dual_dofs = size_of_constraint-primal_dofs;
6767 
6768         if (pcbddc->dbg_flag) {
6769           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);
6770         }
6771 
6772         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6773 
6774           /* copy quadrature constraints for change of basis check */
6775           if (pcbddc->dbg_flag) {
6776             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6777           }
6778           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6779           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6780 
6781           /* compute QR decomposition of constraints */
6782           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6783           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6784           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6785           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6786           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6787           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6788           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6789 
6790           /* explictly compute R^-T */
6791           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6792           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6793           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6794           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6795           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6796           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6797           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6798           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6799           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6800           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6801 
6802           /* explicitly compute all columns of Q (Q = [Q1 | Q2]) overwriting QR factorization in qr_basis */
6803           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6804           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6805           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6806           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6807           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6808           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6809           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6810           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6811 
6812           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6813              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6814              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6815           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6816           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6817           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6818           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6819           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6820           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6821           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6822           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));
6823           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6824           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6825 
6826           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6827           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6828           /* insert cols for primal dofs */
6829           for (j=0;j<primal_dofs;j++) {
6830             start_vals = &qr_basis[j*size_of_constraint];
6831             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6832             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6833           }
6834           /* insert cols for dual dofs */
6835           for (j=0,k=0;j<dual_dofs;k++) {
6836             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6837               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6838               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6839               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6840               j++;
6841             }
6842           }
6843 
6844           /* check change of basis */
6845           if (pcbddc->dbg_flag) {
6846             PetscInt   ii,jj;
6847             PetscBool valid_qr=PETSC_TRUE;
6848             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6849             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6850             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6851             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6852             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6853             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6854             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6855             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));
6856             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6857             for (jj=0;jj<size_of_constraint;jj++) {
6858               for (ii=0;ii<primal_dofs;ii++) {
6859                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6860                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6861               }
6862             }
6863             if (!valid_qr) {
6864               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6865               for (jj=0;jj<size_of_constraint;jj++) {
6866                 for (ii=0;ii<primal_dofs;ii++) {
6867                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6868                     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);
6869                   }
6870                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6871                     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);
6872                   }
6873                 }
6874               }
6875             } else {
6876               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6877             }
6878           }
6879         } else { /* simple transformation block */
6880           PetscInt    row,col;
6881           PetscScalar val,norm;
6882 
6883           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6884           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6885           for (j=0;j<size_of_constraint;j++) {
6886             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6887             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6888             if (!PetscBTLookup(is_primal,row_B)) {
6889               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6890               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6891               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6892             } else {
6893               for (k=0;k<size_of_constraint;k++) {
6894                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6895                 if (row != col) {
6896                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6897                 } else {
6898                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6899                 }
6900                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6901               }
6902             }
6903           }
6904           if (pcbddc->dbg_flag) {
6905             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6906           }
6907         }
6908       } else {
6909         if (pcbddc->dbg_flag) {
6910           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6911         }
6912       }
6913     }
6914 
6915     /* free workspace */
6916     if (qr_needed) {
6917       if (pcbddc->dbg_flag) {
6918         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6919       }
6920       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6921       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6922       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6923       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6924       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6925     }
6926     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6927     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6928     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6929 
6930     /* assembling of global change of variable */
6931     if (!pcbddc->fake_change) {
6932       Mat      tmat;
6933       PetscInt bs;
6934 
6935       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6936       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6937       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6938       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6939       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6940       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6941       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6942       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6943       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6944       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6945       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6946       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6947       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6948       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6949       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6950       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6951       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6952       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6953       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6954       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6955 
6956       /* check */
6957       if (pcbddc->dbg_flag) {
6958         PetscReal error;
6959         Vec       x,x_change;
6960 
6961         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6962         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6963         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6964         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6965         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6966         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6967         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6968         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6969         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6970         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6971         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6972         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6973         if (error > PETSC_SMALL) {
6974           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6975         }
6976         ierr = VecDestroy(&x);CHKERRQ(ierr);
6977         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6978       }
6979       /* adapt sub_schurs computed (if any) */
6980       if (pcbddc->use_deluxe_scaling) {
6981         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6982 
6983         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");
6984         if (sub_schurs && sub_schurs->S_Ej_all) {
6985           Mat                    S_new,tmat;
6986           IS                     is_all_N,is_V_Sall = NULL;
6987 
6988           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6989           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6990           if (pcbddc->deluxe_zerorows) {
6991             ISLocalToGlobalMapping NtoSall;
6992             IS                     is_V;
6993             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6994             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6995             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6996             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6997             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6998           }
6999           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
7000           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7001           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
7002           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7003           if (pcbddc->deluxe_zerorows) {
7004             const PetscScalar *array;
7005             const PetscInt    *idxs_V,*idxs_all;
7006             PetscInt          i,n_V;
7007 
7008             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7009             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
7010             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7011             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7012             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
7013             for (i=0;i<n_V;i++) {
7014               PetscScalar val;
7015               PetscInt    idx;
7016 
7017               idx = idxs_V[i];
7018               val = array[idxs_all[idxs_V[i]]];
7019               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
7020             }
7021             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7022             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7023             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
7024             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7025             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7026           }
7027           sub_schurs->S_Ej_all = S_new;
7028           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7029           if (sub_schurs->sum_S_Ej_all) {
7030             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7031             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
7032             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7033             if (pcbddc->deluxe_zerorows) {
7034               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7035             }
7036             sub_schurs->sum_S_Ej_all = S_new;
7037             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7038           }
7039           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
7040           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
7041         }
7042         /* destroy any change of basis context in sub_schurs */
7043         if (sub_schurs && sub_schurs->change) {
7044           PetscInt i;
7045 
7046           for (i=0;i<sub_schurs->n_subs;i++) {
7047             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
7048           }
7049           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
7050         }
7051       }
7052       if (pcbddc->switch_static) { /* need to save the local change */
7053         pcbddc->switch_static_change = localChangeOfBasisMatrix;
7054       } else {
7055         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
7056       }
7057       /* determine if any process has changed the pressures locally */
7058       pcbddc->change_interior = pcbddc->benign_have_null;
7059     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7060       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7061       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7062       pcbddc->use_qr_single = qr_needed;
7063     }
7064   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7065     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7066       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7067       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7068     } else {
7069       Mat benign_global = NULL;
7070       if (pcbddc->benign_have_null) {
7071         Mat M;
7072 
7073         pcbddc->change_interior = PETSC_TRUE;
7074         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7075         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7076         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7077         if (pcbddc->benign_change) {
7078           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7079           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7080         } else {
7081           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7082           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7083         }
7084         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7085         ierr = MatDestroy(&M);CHKERRQ(ierr);
7086         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7087         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7088       }
7089       if (pcbddc->user_ChangeOfBasisMatrix) {
7090         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7091         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7092       } else if (pcbddc->benign_have_null) {
7093         pcbddc->ChangeOfBasisMatrix = benign_global;
7094       }
7095     }
7096     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7097       IS             is_global;
7098       const PetscInt *gidxs;
7099 
7100       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7101       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7102       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7103       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7104       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7105     }
7106   }
7107   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7108     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7109   }
7110 
7111   if (!pcbddc->fake_change) {
7112     /* add pressure dofs to set of primal nodes for numbering purposes */
7113     for (i=0;i<pcbddc->benign_n;i++) {
7114       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7115       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7116       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7117       pcbddc->local_primal_size_cc++;
7118       pcbddc->local_primal_size++;
7119     }
7120 
7121     /* check if a new primal space has been introduced (also take into account benign trick) */
7122     pcbddc->new_primal_space_local = PETSC_TRUE;
7123     if (olocal_primal_size == pcbddc->local_primal_size) {
7124       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7125       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7126       if (!pcbddc->new_primal_space_local) {
7127         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7128         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7129       }
7130     }
7131     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7132     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7133   }
7134   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7135 
7136   /* flush dbg viewer */
7137   if (pcbddc->dbg_flag) {
7138     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7139   }
7140 
7141   /* free workspace */
7142   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7143   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7144   if (!pcbddc->adaptive_selection) {
7145     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7146     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7147   } else {
7148     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7149                       pcbddc->adaptive_constraints_idxs_ptr,
7150                       pcbddc->adaptive_constraints_data_ptr,
7151                       pcbddc->adaptive_constraints_idxs,
7152                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7153     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7154     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7155   }
7156   PetscFunctionReturn(0);
7157 }
7158 
7159 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7160 {
7161   ISLocalToGlobalMapping map;
7162   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7163   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7164   PetscInt               i,N;
7165   PetscBool              rcsr = PETSC_FALSE;
7166   PetscErrorCode         ierr;
7167 
7168   PetscFunctionBegin;
7169   if (pcbddc->recompute_topography) {
7170     pcbddc->graphanalyzed = PETSC_FALSE;
7171     /* Reset previously computed graph */
7172     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7173     /* Init local Graph struct */
7174     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7175     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7176     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7177 
7178     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7179       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7180     }
7181     /* Check validity of the csr graph passed in by the user */
7182     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);
7183 
7184     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7185     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7186       PetscInt  *xadj,*adjncy;
7187       PetscInt  nvtxs;
7188       PetscBool flg_row=PETSC_FALSE;
7189 
7190       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7191       if (flg_row) {
7192         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7193         pcbddc->computed_rowadj = PETSC_TRUE;
7194       }
7195       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7196       rcsr = PETSC_TRUE;
7197     }
7198     if (pcbddc->dbg_flag) {
7199       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7200     }
7201 
7202     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7203       PetscReal    *lcoords;
7204       PetscInt     n;
7205       MPI_Datatype dimrealtype;
7206 
7207       /* TODO: support for blocked */
7208       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);
7209       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7210       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7211       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7212       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7213       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7214       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7215       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7216       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7217 
7218       pcbddc->mat_graph->coords = lcoords;
7219       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7220       pcbddc->mat_graph->cnloc  = n;
7221     }
7222     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);
7223     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7224 
7225     /* Setup of Graph */
7226     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7227     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7228 
7229     /* attach info on disconnected subdomains if present */
7230     if (pcbddc->n_local_subs) {
7231       PetscInt *local_subs,n,totn;
7232 
7233       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7234       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7235       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7236       for (i=0;i<pcbddc->n_local_subs;i++) {
7237         const PetscInt *idxs;
7238         PetscInt       nl,j;
7239 
7240         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7241         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7242         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7243         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7244       }
7245       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7246       pcbddc->mat_graph->n_local_subs = totn + 1;
7247       pcbddc->mat_graph->local_subs = local_subs;
7248     }
7249   }
7250 
7251   if (!pcbddc->graphanalyzed) {
7252     /* Graph's connected components analysis */
7253     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7254     pcbddc->graphanalyzed = PETSC_TRUE;
7255     pcbddc->corner_selected = pcbddc->corner_selection;
7256   }
7257   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7258   PetscFunctionReturn(0);
7259 }
7260 
7261 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7262 {
7263   PetscInt       i,j,n;
7264   PetscScalar    *alphas;
7265   PetscReal      norm,*onorms;
7266   PetscErrorCode ierr;
7267 
7268   PetscFunctionBegin;
7269   n = *nio;
7270   if (!n) PetscFunctionReturn(0);
7271   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7272   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7273   if (norm < PETSC_SMALL) {
7274     onorms[0] = 0.0;
7275     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7276   } else {
7277     onorms[0] = norm;
7278   }
7279 
7280   for (i=1;i<n;i++) {
7281     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7282     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7283     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7284     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7285     if (norm < PETSC_SMALL) {
7286       onorms[i] = 0.0;
7287       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7288     } else {
7289       onorms[i] = norm;
7290     }
7291   }
7292   /* push nonzero vectors at the beginning */
7293   for (i=0;i<n;i++) {
7294     if (onorms[i] == 0.0) {
7295       for (j=i+1;j<n;j++) {
7296         if (onorms[j] != 0.0) {
7297           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7298           onorms[j] = 0.0;
7299         }
7300       }
7301     }
7302   }
7303   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7304   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7305   PetscFunctionReturn(0);
7306 }
7307 
7308 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7309 {
7310   Mat            A;
7311   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7312   PetscMPIInt    size,rank,color;
7313   PetscInt       *xadj,*adjncy;
7314   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7315   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7316   PetscInt       void_procs,*procs_candidates = NULL;
7317   PetscInt       xadj_count,*count;
7318   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7319   PetscSubcomm   psubcomm;
7320   MPI_Comm       subcomm;
7321   PetscErrorCode ierr;
7322 
7323   PetscFunctionBegin;
7324   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7325   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7326   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);
7327   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7328   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7329   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7330 
7331   if (have_void) *have_void = PETSC_FALSE;
7332   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7333   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7334   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7335   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7336   im_active = !!n;
7337   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7338   void_procs = size - active_procs;
7339   /* get ranks of of non-active processes in mat communicator */
7340   if (void_procs) {
7341     PetscInt ncand;
7342 
7343     if (have_void) *have_void = PETSC_TRUE;
7344     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7345     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7346     for (i=0,ncand=0;i<size;i++) {
7347       if (!procs_candidates[i]) {
7348         procs_candidates[ncand++] = i;
7349       }
7350     }
7351     /* force n_subdomains to be not greater that the number of non-active processes */
7352     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7353   }
7354 
7355   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7356      number of subdomains requested 1 -> send to master or first candidate in voids  */
7357   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7358   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7359     PetscInt issize,isidx,dest;
7360     if (*n_subdomains == 1) dest = 0;
7361     else dest = rank;
7362     if (im_active) {
7363       issize = 1;
7364       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7365         isidx = procs_candidates[dest];
7366       } else {
7367         isidx = dest;
7368       }
7369     } else {
7370       issize = 0;
7371       isidx = -1;
7372     }
7373     if (*n_subdomains != 1) *n_subdomains = active_procs;
7374     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7375     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7376     PetscFunctionReturn(0);
7377   }
7378   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7379   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7380   threshold = PetscMax(threshold,2);
7381 
7382   /* Get info on mapping */
7383   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7384 
7385   /* build local CSR graph of subdomains' connectivity */
7386   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7387   xadj[0] = 0;
7388   xadj[1] = PetscMax(n_neighs-1,0);
7389   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7390   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7391   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7392   for (i=1;i<n_neighs;i++)
7393     for (j=0;j<n_shared[i];j++)
7394       count[shared[i][j]] += 1;
7395 
7396   xadj_count = 0;
7397   for (i=1;i<n_neighs;i++) {
7398     for (j=0;j<n_shared[i];j++) {
7399       if (count[shared[i][j]] < threshold) {
7400         adjncy[xadj_count] = neighs[i];
7401         adjncy_wgt[xadj_count] = n_shared[i];
7402         xadj_count++;
7403         break;
7404       }
7405     }
7406   }
7407   xadj[1] = xadj_count;
7408   ierr = PetscFree(count);CHKERRQ(ierr);
7409   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7410   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7411 
7412   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7413 
7414   /* Restrict work on active processes only */
7415   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7416   if (void_procs) {
7417     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7418     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7419     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7420     subcomm = PetscSubcommChild(psubcomm);
7421   } else {
7422     psubcomm = NULL;
7423     subcomm = PetscObjectComm((PetscObject)mat);
7424   }
7425 
7426   v_wgt = NULL;
7427   if (!color) {
7428     ierr = PetscFree(xadj);CHKERRQ(ierr);
7429     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7430     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7431   } else {
7432     Mat             subdomain_adj;
7433     IS              new_ranks,new_ranks_contig;
7434     MatPartitioning partitioner;
7435     PetscInt        rstart=0,rend=0;
7436     PetscInt        *is_indices,*oldranks;
7437     PetscMPIInt     size;
7438     PetscBool       aggregate;
7439 
7440     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7441     if (void_procs) {
7442       PetscInt prank = rank;
7443       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7444       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7445       for (i=0;i<xadj[1];i++) {
7446         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7447       }
7448       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7449     } else {
7450       oldranks = NULL;
7451     }
7452     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7453     if (aggregate) { /* TODO: all this part could be made more efficient */
7454       PetscInt    lrows,row,ncols,*cols;
7455       PetscMPIInt nrank;
7456       PetscScalar *vals;
7457 
7458       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7459       lrows = 0;
7460       if (nrank<redprocs) {
7461         lrows = size/redprocs;
7462         if (nrank<size%redprocs) lrows++;
7463       }
7464       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7465       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7466       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7467       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7468       row = nrank;
7469       ncols = xadj[1]-xadj[0];
7470       cols = adjncy;
7471       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7472       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7473       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7474       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7475       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7476       ierr = PetscFree(xadj);CHKERRQ(ierr);
7477       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7478       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7479       ierr = PetscFree(vals);CHKERRQ(ierr);
7480       if (use_vwgt) {
7481         Vec               v;
7482         const PetscScalar *array;
7483         PetscInt          nl;
7484 
7485         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7486         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7487         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7488         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7489         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7490         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7491         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7492         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7493         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7494         ierr = VecDestroy(&v);CHKERRQ(ierr);
7495       }
7496     } else {
7497       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7498       if (use_vwgt) {
7499         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7500         v_wgt[0] = n;
7501       }
7502     }
7503     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7504 
7505     /* Partition */
7506     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7507 #if defined(PETSC_HAVE_PTSCOTCH)
7508     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7509 #elif defined(PETSC_HAVE_PARMETIS)
7510     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7511 #else
7512     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7513 #endif
7514     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7515     if (v_wgt) {
7516       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7517     }
7518     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7519     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7520     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7521     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7522     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7523 
7524     /* renumber new_ranks to avoid "holes" in new set of processors */
7525     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7526     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7527     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7528     if (!aggregate) {
7529       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7530         if (PetscUnlikelyDebug(!oldranks)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7531         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7532       } else if (oldranks) {
7533         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7534       } else {
7535         ranks_send_to_idx[0] = is_indices[0];
7536       }
7537     } else {
7538       PetscInt    idx = 0;
7539       PetscMPIInt tag;
7540       MPI_Request *reqs;
7541 
7542       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7543       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7544       for (i=rstart;i<rend;i++) {
7545         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7546       }
7547       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7548       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7549       ierr = PetscFree(reqs);CHKERRQ(ierr);
7550       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7551         if (PetscUnlikelyDebug(!oldranks)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7552         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7553       } else if (oldranks) {
7554         ranks_send_to_idx[0] = oldranks[idx];
7555       } else {
7556         ranks_send_to_idx[0] = idx;
7557       }
7558     }
7559     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7560     /* clean up */
7561     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7562     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7563     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7564     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7565   }
7566   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7567   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7568 
7569   /* assemble parallel IS for sends */
7570   i = 1;
7571   if (!color) i=0;
7572   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7573   PetscFunctionReturn(0);
7574 }
7575 
7576 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7577 
7578 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[])
7579 {
7580   Mat                    local_mat;
7581   IS                     is_sends_internal;
7582   PetscInt               rows,cols,new_local_rows;
7583   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7584   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7585   ISLocalToGlobalMapping l2gmap;
7586   PetscInt*              l2gmap_indices;
7587   const PetscInt*        is_indices;
7588   MatType                new_local_type;
7589   /* buffers */
7590   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7591   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7592   PetscInt               *recv_buffer_idxs_local;
7593   PetscScalar            *ptr_vals,*recv_buffer_vals;
7594   const PetscScalar      *send_buffer_vals;
7595   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7596   /* MPI */
7597   MPI_Comm               comm,comm_n;
7598   PetscSubcomm           subcomm;
7599   PetscMPIInt            n_sends,n_recvs,size;
7600   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7601   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7602   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7603   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7604   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7605   PetscErrorCode         ierr;
7606 
7607   PetscFunctionBegin;
7608   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7609   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7610   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);
7611   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7612   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7613   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7614   PetscValidLogicalCollectiveBool(mat,reuse,6);
7615   PetscValidLogicalCollectiveInt(mat,nis,8);
7616   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7617   if (nvecs) {
7618     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7619     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7620   }
7621   /* further checks */
7622   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7623   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7624   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7625   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7626   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7627   if (reuse && *mat_n) {
7628     PetscInt mrows,mcols,mnrows,mncols;
7629     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7630     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7631     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7632     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7633     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7634     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7635     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7636   }
7637   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7638   PetscValidLogicalCollectiveInt(mat,bs,0);
7639 
7640   /* prepare IS for sending if not provided */
7641   if (!is_sends) {
7642     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7643     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7644   } else {
7645     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7646     is_sends_internal = is_sends;
7647   }
7648 
7649   /* get comm */
7650   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7651 
7652   /* compute number of sends */
7653   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7654   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7655 
7656   /* compute number of receives */
7657   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7658   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7659   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7660   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7661   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7662   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7663   ierr = PetscFree(iflags);CHKERRQ(ierr);
7664 
7665   /* restrict comm if requested */
7666   subcomm = NULL;
7667   destroy_mat = PETSC_FALSE;
7668   if (restrict_comm) {
7669     PetscMPIInt color,subcommsize;
7670 
7671     color = 0;
7672     if (restrict_full) {
7673       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7674     } else {
7675       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7676     }
7677     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7678     subcommsize = size - subcommsize;
7679     /* check if reuse has been requested */
7680     if (reuse) {
7681       if (*mat_n) {
7682         PetscMPIInt subcommsize2;
7683         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7684         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7685         comm_n = PetscObjectComm((PetscObject)*mat_n);
7686       } else {
7687         comm_n = PETSC_COMM_SELF;
7688       }
7689     } else { /* MAT_INITIAL_MATRIX */
7690       PetscMPIInt rank;
7691 
7692       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7693       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7694       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7695       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7696       comm_n = PetscSubcommChild(subcomm);
7697     }
7698     /* flag to destroy *mat_n if not significative */
7699     if (color) destroy_mat = PETSC_TRUE;
7700   } else {
7701     comm_n = comm;
7702   }
7703 
7704   /* prepare send/receive buffers */
7705   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7706   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7707   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7708   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7709   if (nis) {
7710     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7711   }
7712 
7713   /* Get data from local matrices */
7714   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7715     /* TODO: See below some guidelines on how to prepare the local buffers */
7716     /*
7717        send_buffer_vals should contain the raw values of the local matrix
7718        send_buffer_idxs should contain:
7719        - MatType_PRIVATE type
7720        - PetscInt        size_of_l2gmap
7721        - PetscInt        global_row_indices[size_of_l2gmap]
7722        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7723     */
7724   else {
7725     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7726     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7727     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7728     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7729     send_buffer_idxs[1] = i;
7730     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7731     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7732     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7733     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7734     for (i=0;i<n_sends;i++) {
7735       ilengths_vals[is_indices[i]] = len*len;
7736       ilengths_idxs[is_indices[i]] = len+2;
7737     }
7738   }
7739   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7740   /* additional is (if any) */
7741   if (nis) {
7742     PetscMPIInt psum;
7743     PetscInt j;
7744     for (j=0,psum=0;j<nis;j++) {
7745       PetscInt plen;
7746       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7747       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7748       psum += len+1; /* indices + lenght */
7749     }
7750     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7751     for (j=0,psum=0;j<nis;j++) {
7752       PetscInt plen;
7753       const PetscInt *is_array_idxs;
7754       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7755       send_buffer_idxs_is[psum] = plen;
7756       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7757       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7758       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7759       psum += plen+1; /* indices + lenght */
7760     }
7761     for (i=0;i<n_sends;i++) {
7762       ilengths_idxs_is[is_indices[i]] = psum;
7763     }
7764     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7765   }
7766   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7767 
7768   buf_size_idxs = 0;
7769   buf_size_vals = 0;
7770   buf_size_idxs_is = 0;
7771   buf_size_vecs = 0;
7772   for (i=0;i<n_recvs;i++) {
7773     buf_size_idxs += (PetscInt)olengths_idxs[i];
7774     buf_size_vals += (PetscInt)olengths_vals[i];
7775     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7776     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7777   }
7778   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7779   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7780   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7781   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7782 
7783   /* get new tags for clean communications */
7784   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7785   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7786   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7787   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7788 
7789   /* allocate for requests */
7790   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7791   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7792   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7793   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7794   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7795   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7796   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7797   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7798 
7799   /* communications */
7800   ptr_idxs = recv_buffer_idxs;
7801   ptr_vals = recv_buffer_vals;
7802   ptr_idxs_is = recv_buffer_idxs_is;
7803   ptr_vecs = recv_buffer_vecs;
7804   for (i=0;i<n_recvs;i++) {
7805     source_dest = onodes[i];
7806     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7807     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7808     ptr_idxs += olengths_idxs[i];
7809     ptr_vals += olengths_vals[i];
7810     if (nis) {
7811       source_dest = onodes_is[i];
7812       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);
7813       ptr_idxs_is += olengths_idxs_is[i];
7814     }
7815     if (nvecs) {
7816       source_dest = onodes[i];
7817       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7818       ptr_vecs += olengths_idxs[i]-2;
7819     }
7820   }
7821   for (i=0;i<n_sends;i++) {
7822     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7823     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7824     ierr = MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7825     if (nis) {
7826       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);
7827     }
7828     if (nvecs) {
7829       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7830       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7831     }
7832   }
7833   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7834   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7835 
7836   /* assemble new l2g map */
7837   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7838   ptr_idxs = recv_buffer_idxs;
7839   new_local_rows = 0;
7840   for (i=0;i<n_recvs;i++) {
7841     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7842     ptr_idxs += olengths_idxs[i];
7843   }
7844   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7845   ptr_idxs = recv_buffer_idxs;
7846   new_local_rows = 0;
7847   for (i=0;i<n_recvs;i++) {
7848     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7849     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7850     ptr_idxs += olengths_idxs[i];
7851   }
7852   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7853   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7854   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7855 
7856   /* infer new local matrix type from received local matrices type */
7857   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7858   /* 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) */
7859   if (n_recvs) {
7860     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7861     ptr_idxs = recv_buffer_idxs;
7862     for (i=0;i<n_recvs;i++) {
7863       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7864         new_local_type_private = MATAIJ_PRIVATE;
7865         break;
7866       }
7867       ptr_idxs += olengths_idxs[i];
7868     }
7869     switch (new_local_type_private) {
7870       case MATDENSE_PRIVATE:
7871         new_local_type = MATSEQAIJ;
7872         bs = 1;
7873         break;
7874       case MATAIJ_PRIVATE:
7875         new_local_type = MATSEQAIJ;
7876         bs = 1;
7877         break;
7878       case MATBAIJ_PRIVATE:
7879         new_local_type = MATSEQBAIJ;
7880         break;
7881       case MATSBAIJ_PRIVATE:
7882         new_local_type = MATSEQSBAIJ;
7883         break;
7884       default:
7885         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7886         break;
7887     }
7888   } else { /* by default, new_local_type is seqaij */
7889     new_local_type = MATSEQAIJ;
7890     bs = 1;
7891   }
7892 
7893   /* create MATIS object if needed */
7894   if (!reuse) {
7895     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7896     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7897   } else {
7898     /* it also destroys the local matrices */
7899     if (*mat_n) {
7900       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7901     } else { /* this is a fake object */
7902       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7903     }
7904   }
7905   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7906   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7907 
7908   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7909 
7910   /* Global to local map of received indices */
7911   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7912   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7913   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7914 
7915   /* restore attributes -> type of incoming data and its size */
7916   buf_size_idxs = 0;
7917   for (i=0;i<n_recvs;i++) {
7918     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7919     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7920     buf_size_idxs += (PetscInt)olengths_idxs[i];
7921   }
7922   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7923 
7924   /* set preallocation */
7925   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7926   if (!newisdense) {
7927     PetscInt *new_local_nnz=NULL;
7928 
7929     ptr_idxs = recv_buffer_idxs_local;
7930     if (n_recvs) {
7931       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7932     }
7933     for (i=0;i<n_recvs;i++) {
7934       PetscInt j;
7935       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7936         for (j=0;j<*(ptr_idxs+1);j++) {
7937           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7938         }
7939       } else {
7940         /* TODO */
7941       }
7942       ptr_idxs += olengths_idxs[i];
7943     }
7944     if (new_local_nnz) {
7945       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7946       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7947       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7948       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7949       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7950       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7951     } else {
7952       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7953     }
7954     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7955   } else {
7956     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7957   }
7958 
7959   /* set values */
7960   ptr_vals = recv_buffer_vals;
7961   ptr_idxs = recv_buffer_idxs_local;
7962   for (i=0;i<n_recvs;i++) {
7963     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7964       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7965       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7966       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7967       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7968       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7969     } else {
7970       /* TODO */
7971     }
7972     ptr_idxs += olengths_idxs[i];
7973     ptr_vals += olengths_vals[i];
7974   }
7975   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7976   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7977   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7978   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7979   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7980   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7981 
7982 #if 0
7983   if (!restrict_comm) { /* check */
7984     Vec       lvec,rvec;
7985     PetscReal infty_error;
7986 
7987     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7988     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7989     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7990     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7991     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7992     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7993     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7994     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7995     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7996   }
7997 #endif
7998 
7999   /* assemble new additional is (if any) */
8000   if (nis) {
8001     PetscInt **temp_idxs,*count_is,j,psum;
8002 
8003     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8004     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
8005     ptr_idxs = recv_buffer_idxs_is;
8006     psum = 0;
8007     for (i=0;i<n_recvs;i++) {
8008       for (j=0;j<nis;j++) {
8009         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8010         count_is[j] += plen; /* increment counting of buffer for j-th IS */
8011         psum += plen;
8012         ptr_idxs += plen+1; /* shift pointer to received data */
8013       }
8014     }
8015     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
8016     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
8017     for (i=1;i<nis;i++) {
8018       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
8019     }
8020     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
8021     ptr_idxs = recv_buffer_idxs_is;
8022     for (i=0;i<n_recvs;i++) {
8023       for (j=0;j<nis;j++) {
8024         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8025         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
8026         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
8027         ptr_idxs += plen+1; /* shift pointer to received data */
8028       }
8029     }
8030     for (i=0;i<nis;i++) {
8031       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8032       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);
8033       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8034     }
8035     ierr = PetscFree(count_is);CHKERRQ(ierr);
8036     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
8037     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
8038   }
8039   /* free workspace */
8040   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
8041   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8042   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
8043   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8044   if (isdense) {
8045     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
8046     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
8047     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
8048   } else {
8049     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
8050   }
8051   if (nis) {
8052     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8053     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
8054   }
8055 
8056   if (nvecs) {
8057     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8058     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8059     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8060     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8061     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
8062     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
8063     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
8064     /* set values */
8065     ptr_vals = recv_buffer_vecs;
8066     ptr_idxs = recv_buffer_idxs_local;
8067     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8068     for (i=0;i<n_recvs;i++) {
8069       PetscInt j;
8070       for (j=0;j<*(ptr_idxs+1);j++) {
8071         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8072       }
8073       ptr_idxs += olengths_idxs[i];
8074       ptr_vals += olengths_idxs[i]-2;
8075     }
8076     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8077     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
8078     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
8079   }
8080 
8081   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
8082   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
8083   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
8084   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
8085   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
8086   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8087   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8088   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8089   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8090   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8091   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8092   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8093   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8094   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8095   ierr = PetscFree(onodes);CHKERRQ(ierr);
8096   if (nis) {
8097     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8098     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8099     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8100   }
8101   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8102   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8103     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8104     for (i=0;i<nis;i++) {
8105       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8106     }
8107     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8108       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8109     }
8110     *mat_n = NULL;
8111   }
8112   PetscFunctionReturn(0);
8113 }
8114 
8115 /* temporary hack into ksp private data structure */
8116 #include <petsc/private/kspimpl.h>
8117 
8118 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8119 {
8120   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8121   PC_IS                  *pcis = (PC_IS*)pc->data;
8122   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8123   Mat                    coarsedivudotp = NULL;
8124   Mat                    coarseG,t_coarse_mat_is;
8125   MatNullSpace           CoarseNullSpace = NULL;
8126   ISLocalToGlobalMapping coarse_islg;
8127   IS                     coarse_is,*isarray,corners;
8128   PetscInt               i,im_active=-1,active_procs=-1;
8129   PetscInt               nis,nisdofs,nisneu,nisvert;
8130   PetscInt               coarse_eqs_per_proc;
8131   PC                     pc_temp;
8132   PCType                 coarse_pc_type;
8133   KSPType                coarse_ksp_type;
8134   PetscBool              multilevel_requested,multilevel_allowed;
8135   PetscBool              coarse_reuse;
8136   PetscInt               ncoarse,nedcfield;
8137   PetscBool              compute_vecs = PETSC_FALSE;
8138   PetscScalar            *array;
8139   MatReuse               coarse_mat_reuse;
8140   PetscBool              restr, full_restr, have_void;
8141   PetscMPIInt            size;
8142   PetscErrorCode         ierr;
8143 
8144   PetscFunctionBegin;
8145   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8146   /* Assign global numbering to coarse dofs */
8147   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 */
8148     PetscInt ocoarse_size;
8149     compute_vecs = PETSC_TRUE;
8150 
8151     pcbddc->new_primal_space = PETSC_TRUE;
8152     ocoarse_size = pcbddc->coarse_size;
8153     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8154     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8155     /* see if we can avoid some work */
8156     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8157       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8158       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8159         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8160         coarse_reuse = PETSC_FALSE;
8161       } else { /* we can safely reuse already computed coarse matrix */
8162         coarse_reuse = PETSC_TRUE;
8163       }
8164     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8165       coarse_reuse = PETSC_FALSE;
8166     }
8167     /* reset any subassembling information */
8168     if (!coarse_reuse || pcbddc->recompute_topography) {
8169       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8170     }
8171   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8172     coarse_reuse = PETSC_TRUE;
8173   }
8174   if (coarse_reuse && pcbddc->coarse_ksp) {
8175     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8176     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8177     coarse_mat_reuse = MAT_REUSE_MATRIX;
8178   } else {
8179     coarse_mat = NULL;
8180     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8181   }
8182 
8183   /* creates temporary l2gmap and IS for coarse indexes */
8184   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8185   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8186 
8187   /* creates temporary MATIS object for coarse matrix */
8188   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8189   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);
8190   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8191   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8192   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8193   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8194 
8195   /* count "active" (i.e. with positive local size) and "void" processes */
8196   im_active = !!(pcis->n);
8197   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8198 
8199   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8200   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8201   /* full_restr : just use the receivers from the subassembling pattern */
8202   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8203   coarse_mat_is        = NULL;
8204   multilevel_allowed   = PETSC_FALSE;
8205   multilevel_requested = PETSC_FALSE;
8206   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8207   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8208   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8209   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8210   if (multilevel_requested) {
8211     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8212     restr      = PETSC_FALSE;
8213     full_restr = PETSC_FALSE;
8214   } else {
8215     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8216     restr      = PETSC_TRUE;
8217     full_restr = PETSC_TRUE;
8218   }
8219   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8220   ncoarse = PetscMax(1,ncoarse);
8221   if (!pcbddc->coarse_subassembling) {
8222     if (pcbddc->coarsening_ratio > 1) {
8223       if (multilevel_requested) {
8224         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8225       } else {
8226         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8227       }
8228     } else {
8229       PetscMPIInt rank;
8230 
8231       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8232       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8233       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8234     }
8235   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8236     PetscInt    psum;
8237     if (pcbddc->coarse_ksp) psum = 1;
8238     else psum = 0;
8239     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8240     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8241   }
8242   /* determine if we can go multilevel */
8243   if (multilevel_requested) {
8244     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8245     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8246   }
8247   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8248 
8249   /* dump subassembling pattern */
8250   if (pcbddc->dbg_flag && multilevel_allowed) {
8251     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8252   }
8253   /* compute dofs splitting and neumann boundaries for coarse dofs */
8254   nedcfield = -1;
8255   corners = NULL;
8256   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8257     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8258     const PetscInt         *idxs;
8259     ISLocalToGlobalMapping tmap;
8260 
8261     /* create map between primal indices (in local representative ordering) and local primal numbering */
8262     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8263     /* allocate space for temporary storage */
8264     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8265     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8266     /* allocate for IS array */
8267     nisdofs = pcbddc->n_ISForDofsLocal;
8268     if (pcbddc->nedclocal) {
8269       if (pcbddc->nedfield > -1) {
8270         nedcfield = pcbddc->nedfield;
8271       } else {
8272         nedcfield = 0;
8273         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8274         nisdofs = 1;
8275       }
8276     }
8277     nisneu = !!pcbddc->NeumannBoundariesLocal;
8278     nisvert = 0; /* nisvert is not used */
8279     nis = nisdofs + nisneu + nisvert;
8280     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8281     /* dofs splitting */
8282     for (i=0;i<nisdofs;i++) {
8283       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8284       if (nedcfield != i) {
8285         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8286         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8287         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8288         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8289       } else {
8290         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8291         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8292         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8293         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8294         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8295       }
8296       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8297       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8298       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8299     }
8300     /* neumann boundaries */
8301     if (pcbddc->NeumannBoundariesLocal) {
8302       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8303       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8304       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8305       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8306       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8307       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8308       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8309       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8310     }
8311     /* coordinates */
8312     if (pcbddc->corner_selected) {
8313       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8314       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8315       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8316       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8317       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8318       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8319       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8320       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8321       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8322     }
8323     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8324     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8325     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8326   } else {
8327     nis = 0;
8328     nisdofs = 0;
8329     nisneu = 0;
8330     nisvert = 0;
8331     isarray = NULL;
8332   }
8333   /* destroy no longer needed map */
8334   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8335 
8336   /* subassemble */
8337   if (multilevel_allowed) {
8338     Vec       vp[1];
8339     PetscInt  nvecs = 0;
8340     PetscBool reuse,reuser;
8341 
8342     if (coarse_mat) reuse = PETSC_TRUE;
8343     else reuse = PETSC_FALSE;
8344     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8345     vp[0] = NULL;
8346     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8347       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8348       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8349       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8350       nvecs = 1;
8351 
8352       if (pcbddc->divudotp) {
8353         Mat      B,loc_divudotp;
8354         Vec      v,p;
8355         IS       dummy;
8356         PetscInt np;
8357 
8358         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8359         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8360         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8361         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8362         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8363         ierr = VecSet(p,1.);CHKERRQ(ierr);
8364         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8365         ierr = VecDestroy(&p);CHKERRQ(ierr);
8366         ierr = MatDestroy(&B);CHKERRQ(ierr);
8367         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8368         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8369         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8370         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8371         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8372         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8373         ierr = VecDestroy(&v);CHKERRQ(ierr);
8374       }
8375     }
8376     if (reuser) {
8377       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8378     } else {
8379       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8380     }
8381     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8382       PetscScalar       *arraym;
8383       const PetscScalar *arrayv;
8384       PetscInt          nl;
8385       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8386       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8387       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8388       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8389       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8390       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8391       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8392       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8393     } else {
8394       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8395     }
8396   } else {
8397     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8398   }
8399   if (coarse_mat_is || coarse_mat) {
8400     if (!multilevel_allowed) {
8401       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8402     } else {
8403       /* if this matrix is present, it means we are not reusing the coarse matrix */
8404       if (coarse_mat_is) {
8405         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8406         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8407         coarse_mat = coarse_mat_is;
8408       }
8409     }
8410   }
8411   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8412   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8413 
8414   /* create local to global scatters for coarse problem */
8415   if (compute_vecs) {
8416     PetscInt lrows;
8417     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8418     if (coarse_mat) {
8419       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8420     } else {
8421       lrows = 0;
8422     }
8423     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8424     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8425     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8426     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8427     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8428   }
8429   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8430 
8431   /* set defaults for coarse KSP and PC */
8432   if (multilevel_allowed) {
8433     coarse_ksp_type = KSPRICHARDSON;
8434     coarse_pc_type  = PCBDDC;
8435   } else {
8436     coarse_ksp_type = KSPPREONLY;
8437     coarse_pc_type  = PCREDUNDANT;
8438   }
8439 
8440   /* print some info if requested */
8441   if (pcbddc->dbg_flag) {
8442     if (!multilevel_allowed) {
8443       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8444       if (multilevel_requested) {
8445         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);
8446       } else if (pcbddc->max_levels) {
8447         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8448       }
8449       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8450     }
8451   }
8452 
8453   /* communicate coarse discrete gradient */
8454   coarseG = NULL;
8455   if (pcbddc->nedcG && multilevel_allowed) {
8456     MPI_Comm ccomm;
8457     if (coarse_mat) {
8458       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8459     } else {
8460       ccomm = MPI_COMM_NULL;
8461     }
8462     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8463   }
8464 
8465   /* create the coarse KSP object only once with defaults */
8466   if (coarse_mat) {
8467     PetscBool   isredundant,isbddc,force,valid;
8468     PetscViewer dbg_viewer = NULL;
8469 
8470     if (pcbddc->dbg_flag) {
8471       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8472       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8473     }
8474     if (!pcbddc->coarse_ksp) {
8475       char   prefix[256],str_level[16];
8476       size_t len;
8477 
8478       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8479       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8480       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8481       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8482       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8483       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8484       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8485       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8486       /* TODO is this logic correct? should check for coarse_mat type */
8487       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8488       /* prefix */
8489       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8490       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8491       if (!pcbddc->current_level) {
8492         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8493         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8494       } else {
8495         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8496         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8497         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8498         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8499         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8500         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8501         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8502       }
8503       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8504       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8505       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8506       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8507       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8508       /* allow user customization */
8509       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8510       /* get some info after set from options */
8511       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8512       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8513       force = PETSC_FALSE;
8514       ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8515       ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8516       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8517       if (multilevel_allowed && !force && !valid) {
8518         isbddc = PETSC_TRUE;
8519         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8520         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8521         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8522         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8523         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8524           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8525           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8526           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8527           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8528           pc_temp->setfromoptionscalled++;
8529         }
8530       }
8531     }
8532     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8533     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8534     if (nisdofs) {
8535       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8536       for (i=0;i<nisdofs;i++) {
8537         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8538       }
8539     }
8540     if (nisneu) {
8541       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8542       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8543     }
8544     if (nisvert) {
8545       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8546       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8547     }
8548     if (coarseG) {
8549       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8550     }
8551 
8552     /* get some info after set from options */
8553     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8554 
8555     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8556     if (isbddc && !multilevel_allowed) {
8557       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8558     }
8559     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8560     force = PETSC_FALSE;
8561     ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8562     ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8563     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8564       ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8565     }
8566     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8567     if (isredundant) {
8568       KSP inner_ksp;
8569       PC  inner_pc;
8570 
8571       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8572       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8573     }
8574 
8575     /* parameters which miss an API */
8576     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8577     if (isbddc) {
8578       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8579 
8580       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8581       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8582       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8583       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8584       if (pcbddc_coarse->benign_saddle_point) {
8585         Mat                    coarsedivudotp_is;
8586         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8587         IS                     row,col;
8588         const PetscInt         *gidxs;
8589         PetscInt               n,st,M,N;
8590 
8591         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8592         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8593         st   = st-n;
8594         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8595         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8596         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8597         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8598         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8599         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8600         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8601         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8602         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8603         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8604         ierr = ISDestroy(&row);CHKERRQ(ierr);
8605         ierr = ISDestroy(&col);CHKERRQ(ierr);
8606         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8607         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8608         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8609         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8610         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8611         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8612         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8613         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8614         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8615         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8616         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8617         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8618       }
8619     }
8620 
8621     /* propagate symmetry info of coarse matrix */
8622     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8623     if (pc->pmat->symmetric_set) {
8624       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8625     }
8626     if (pc->pmat->hermitian_set) {
8627       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8628     }
8629     if (pc->pmat->spd_set) {
8630       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8631     }
8632     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8633       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8634     }
8635     /* set operators */
8636     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8637     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8638     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8639     if (pcbddc->dbg_flag) {
8640       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8641     }
8642   }
8643   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8644   ierr = PetscFree(isarray);CHKERRQ(ierr);
8645 #if 0
8646   {
8647     PetscViewer viewer;
8648     char filename[256];
8649     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8650     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8651     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8652     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8653     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8654     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8655   }
8656 #endif
8657 
8658   if (corners) {
8659     Vec            gv;
8660     IS             is;
8661     const PetscInt *idxs;
8662     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8663     PetscScalar    *coords;
8664 
8665     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8666     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8667     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8668     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8669     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8670     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8671     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8672     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8673     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8674 
8675     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8676     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8677     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8678     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8679     for (i=0;i<n;i++) {
8680       for (d=0;d<cdim;d++) {
8681         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8682       }
8683     }
8684     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8685     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8686 
8687     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8688     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8689     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8690     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8691     ierr = PetscFree(coords);CHKERRQ(ierr);
8692     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8693     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8694     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8695     if (pcbddc->coarse_ksp) {
8696       PC        coarse_pc;
8697       PetscBool isbddc;
8698 
8699       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8700       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8701       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8702         PetscReal *realcoords;
8703 
8704         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8705 #if defined(PETSC_USE_COMPLEX)
8706         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8707         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8708 #else
8709         realcoords = coords;
8710 #endif
8711         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8712 #if defined(PETSC_USE_COMPLEX)
8713         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8714 #endif
8715       }
8716     }
8717     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8718     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8719   }
8720   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8721 
8722   if (pcbddc->coarse_ksp) {
8723     Vec crhs,csol;
8724 
8725     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8726     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8727     if (!csol) {
8728       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8729     }
8730     if (!crhs) {
8731       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8732     }
8733   }
8734   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8735 
8736   /* compute null space for coarse solver if the benign trick has been requested */
8737   if (pcbddc->benign_null) {
8738 
8739     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8740     for (i=0;i<pcbddc->benign_n;i++) {
8741       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8742     }
8743     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8744     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8745     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8746     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8747     if (coarse_mat) {
8748       Vec         nullv;
8749       PetscScalar *array,*array2;
8750       PetscInt    nl;
8751 
8752       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8753       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8754       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8755       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8756       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8757       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8758       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8759       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8760       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8761       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8762     }
8763   }
8764   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8765 
8766   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8767   if (pcbddc->coarse_ksp) {
8768     PetscBool ispreonly;
8769 
8770     if (CoarseNullSpace) {
8771       PetscBool isnull;
8772       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8773       if (isnull) {
8774         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8775       }
8776       /* TODO: add local nullspaces (if any) */
8777     }
8778     /* setup coarse ksp */
8779     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8780     /* Check coarse problem if in debug mode or if solving with an iterative method */
8781     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8782     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates)) {
8783       KSP       check_ksp;
8784       KSPType   check_ksp_type;
8785       PC        check_pc;
8786       Vec       check_vec,coarse_vec;
8787       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8788       PetscInt  its;
8789       PetscBool compute_eigs;
8790       PetscReal *eigs_r,*eigs_c;
8791       PetscInt  neigs;
8792       const char *prefix;
8793 
8794       /* Create ksp object suitable for estimation of extreme eigenvalues */
8795       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8796       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8797       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8798       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8799       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8800       /* prevent from setup unneeded object */
8801       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8802       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8803       if (ispreonly) {
8804         check_ksp_type = KSPPREONLY;
8805         compute_eigs = PETSC_FALSE;
8806       } else {
8807         check_ksp_type = KSPGMRES;
8808         compute_eigs = PETSC_TRUE;
8809       }
8810       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8811       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8812       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8813       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8814       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8815       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8816       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8817       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8818       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8819       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8820       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8821       /* create random vec */
8822       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8823       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8824       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8825       /* solve coarse problem */
8826       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8827       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8828       /* set eigenvalue estimation if preonly has not been requested */
8829       if (compute_eigs) {
8830         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8831         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8832         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8833         if (neigs) {
8834           lambda_max = eigs_r[neigs-1];
8835           lambda_min = eigs_r[0];
8836           if (pcbddc->use_coarse_estimates) {
8837             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8838               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8839               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8840             }
8841           }
8842         }
8843       }
8844 
8845       /* check coarse problem residual error */
8846       if (pcbddc->dbg_flag) {
8847         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8848         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8849         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8850         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8851         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8852         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8853         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8854         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8855         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8856         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8857         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8858         if (CoarseNullSpace) {
8859           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8860         }
8861         if (compute_eigs) {
8862           PetscReal          lambda_max_s,lambda_min_s;
8863           KSPConvergedReason reason;
8864           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8865           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8866           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8867           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8868           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);
8869           for (i=0;i<neigs;i++) {
8870             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8871           }
8872         }
8873         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8874         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8875       }
8876       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8877       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8878       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8879       if (compute_eigs) {
8880         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8881         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8882       }
8883     }
8884   }
8885   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8886   /* print additional info */
8887   if (pcbddc->dbg_flag) {
8888     /* waits until all processes reaches this point */
8889     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8890     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8891     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8892   }
8893 
8894   /* free memory */
8895   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8896   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8897   PetscFunctionReturn(0);
8898 }
8899 
8900 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8901 {
8902   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8903   PC_IS*         pcis = (PC_IS*)pc->data;
8904   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8905   IS             subset,subset_mult,subset_n;
8906   PetscInt       local_size,coarse_size=0;
8907   PetscInt       *local_primal_indices=NULL;
8908   const PetscInt *t_local_primal_indices;
8909   PetscErrorCode ierr;
8910 
8911   PetscFunctionBegin;
8912   /* Compute global number of coarse dofs */
8913   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8914   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8915   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8916   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8917   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8918   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8919   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8920   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8921   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8922   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);
8923   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8924   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8925   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8926   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8927   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8928 
8929   /* check numbering */
8930   if (pcbddc->dbg_flag) {
8931     PetscScalar coarsesum,*array,*array2;
8932     PetscInt    i;
8933     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8934 
8935     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8936     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8937     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8938     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8939     /* counter */
8940     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8941     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8942     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8943     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8944     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8945     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8946     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8947     for (i=0;i<pcbddc->local_primal_size;i++) {
8948       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8949     }
8950     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8951     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8952     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8953     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8954     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8955     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8956     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8957     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8958     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8959     for (i=0;i<pcis->n;i++) {
8960       if (array[i] != 0.0 && array[i] != array2[i]) {
8961         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8962         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8963         set_error = PETSC_TRUE;
8964         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8965         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);
8966       }
8967     }
8968     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8969     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8970     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8971     for (i=0;i<pcis->n;i++) {
8972       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8973     }
8974     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8975     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8976     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8977     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8978     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8979     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8980     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8981       PetscInt *gidxs;
8982 
8983       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8984       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8985       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8986       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8987       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8988       for (i=0;i<pcbddc->local_primal_size;i++) {
8989         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);
8990       }
8991       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8992       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8993     }
8994     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8995     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8996     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8997   }
8998 
8999   /* get back data */
9000   *coarse_size_n = coarse_size;
9001   *local_primal_indices_n = local_primal_indices;
9002   PetscFunctionReturn(0);
9003 }
9004 
9005 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
9006 {
9007   IS             localis_t;
9008   PetscInt       i,lsize,*idxs,n;
9009   PetscScalar    *vals;
9010   PetscErrorCode ierr;
9011 
9012   PetscFunctionBegin;
9013   /* get indices in local ordering exploiting local to global map */
9014   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
9015   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
9016   for (i=0;i<lsize;i++) vals[i] = 1.0;
9017   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9018   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
9019   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
9020   if (idxs) { /* multilevel guard */
9021     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
9022     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
9023   }
9024   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
9025   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9026   ierr = PetscFree(vals);CHKERRQ(ierr);
9027   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
9028   /* now compute set in local ordering */
9029   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9030   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9031   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9032   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
9033   for (i=0,lsize=0;i<n;i++) {
9034     if (PetscRealPart(vals[i]) > 0.5) {
9035       lsize++;
9036     }
9037   }
9038   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
9039   for (i=0,lsize=0;i<n;i++) {
9040     if (PetscRealPart(vals[i]) > 0.5) {
9041       idxs[lsize++] = i;
9042     }
9043   }
9044   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9045   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
9046   *localis = localis_t;
9047   PetscFunctionReturn(0);
9048 }
9049 
9050 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
9051 {
9052   PC_IS               *pcis=(PC_IS*)pc->data;
9053   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9054   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9055   Mat                 S_j;
9056   PetscInt            *used_xadj,*used_adjncy;
9057   PetscBool           free_used_adj;
9058   PetscErrorCode      ierr;
9059 
9060   PetscFunctionBegin;
9061   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9062   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9063   free_used_adj = PETSC_FALSE;
9064   if (pcbddc->sub_schurs_layers == -1) {
9065     used_xadj = NULL;
9066     used_adjncy = NULL;
9067   } else {
9068     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9069       used_xadj = pcbddc->mat_graph->xadj;
9070       used_adjncy = pcbddc->mat_graph->adjncy;
9071     } else if (pcbddc->computed_rowadj) {
9072       used_xadj = pcbddc->mat_graph->xadj;
9073       used_adjncy = pcbddc->mat_graph->adjncy;
9074     } else {
9075       PetscBool      flg_row=PETSC_FALSE;
9076       const PetscInt *xadj,*adjncy;
9077       PetscInt       nvtxs;
9078 
9079       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9080       if (flg_row) {
9081         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
9082         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
9083         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
9084         free_used_adj = PETSC_TRUE;
9085       } else {
9086         pcbddc->sub_schurs_layers = -1;
9087         used_xadj = NULL;
9088         used_adjncy = NULL;
9089       }
9090       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9091     }
9092   }
9093 
9094   /* setup sub_schurs data */
9095   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9096   if (!sub_schurs->schur_explicit) {
9097     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9098     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9099     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);
9100   } else {
9101     Mat       change = NULL;
9102     Vec       scaling = NULL;
9103     IS        change_primal = NULL, iP;
9104     PetscInt  benign_n;
9105     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9106     PetscBool need_change = PETSC_FALSE;
9107     PetscBool discrete_harmonic = PETSC_FALSE;
9108 
9109     if (!pcbddc->use_vertices && reuse_solvers) {
9110       PetscInt n_vertices;
9111 
9112       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9113       reuse_solvers = (PetscBool)!n_vertices;
9114     }
9115     if (!pcbddc->benign_change_explicit) {
9116       benign_n = pcbddc->benign_n;
9117     } else {
9118       benign_n = 0;
9119     }
9120     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9121        We need a global reduction to avoid possible deadlocks.
9122        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9123     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9124       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9125       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9126       need_change = (PetscBool)(!need_change);
9127     }
9128     /* If the user defines additional constraints, we import them here.
9129        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 */
9130     if (need_change) {
9131       PC_IS   *pcisf;
9132       PC_BDDC *pcbddcf;
9133       PC      pcf;
9134 
9135       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9136       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9137       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9138       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9139 
9140       /* hacks */
9141       pcisf                        = (PC_IS*)pcf->data;
9142       pcisf->is_B_local            = pcis->is_B_local;
9143       pcisf->vec1_N                = pcis->vec1_N;
9144       pcisf->BtoNmap               = pcis->BtoNmap;
9145       pcisf->n                     = pcis->n;
9146       pcisf->n_B                   = pcis->n_B;
9147       pcbddcf                      = (PC_BDDC*)pcf->data;
9148       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9149       pcbddcf->mat_graph           = pcbddc->mat_graph;
9150       pcbddcf->use_faces           = PETSC_TRUE;
9151       pcbddcf->use_change_of_basis = PETSC_TRUE;
9152       pcbddcf->use_change_on_faces = PETSC_TRUE;
9153       pcbddcf->use_qr_single       = PETSC_TRUE;
9154       pcbddcf->fake_change         = PETSC_TRUE;
9155 
9156       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9157       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9158       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9159       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9160       change = pcbddcf->ConstraintMatrix;
9161       pcbddcf->ConstraintMatrix = NULL;
9162 
9163       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9164       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9165       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9166       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9167       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9168       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9169       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9170       pcf->ops->destroy = NULL;
9171       pcf->ops->reset   = NULL;
9172       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9173     }
9174     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9175 
9176     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9177     if (iP) {
9178       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9179       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9180       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9181     }
9182     if (discrete_harmonic) {
9183       Mat A;
9184       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9185       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9186       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9187       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);
9188       ierr = MatDestroy(&A);CHKERRQ(ierr);
9189     } else {
9190       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);
9191     }
9192     ierr = MatDestroy(&change);CHKERRQ(ierr);
9193     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9194   }
9195   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9196 
9197   /* free adjacency */
9198   if (free_used_adj) {
9199     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9200   }
9201   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9202   PetscFunctionReturn(0);
9203 }
9204 
9205 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9206 {
9207   PC_IS               *pcis=(PC_IS*)pc->data;
9208   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9209   PCBDDCGraph         graph;
9210   PetscErrorCode      ierr;
9211 
9212   PetscFunctionBegin;
9213   /* attach interface graph for determining subsets */
9214   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9215     IS       verticesIS,verticescomm;
9216     PetscInt vsize,*idxs;
9217 
9218     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9219     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9220     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9221     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9222     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9223     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9224     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9225     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9226     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9227     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9228     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9229   } else {
9230     graph = pcbddc->mat_graph;
9231   }
9232   /* print some info */
9233   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9234     IS       vertices;
9235     PetscInt nv,nedges,nfaces;
9236     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9237     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9238     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9239     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9240     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9241     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9242     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9243     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9244     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9245     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9246     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9247   }
9248 
9249   /* sub_schurs init */
9250   if (!pcbddc->sub_schurs) {
9251     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9252   }
9253   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);
9254 
9255   /* free graph struct */
9256   if (pcbddc->sub_schurs_rebuild) {
9257     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9258   }
9259   PetscFunctionReturn(0);
9260 }
9261 
9262 PetscErrorCode PCBDDCCheckOperator(PC pc)
9263 {
9264   PC_IS               *pcis=(PC_IS*)pc->data;
9265   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9266   PetscErrorCode      ierr;
9267 
9268   PetscFunctionBegin;
9269   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9270     IS             zerodiag = NULL;
9271     Mat            S_j,B0_B=NULL;
9272     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9273     PetscScalar    *p0_check,*array,*array2;
9274     PetscReal      norm;
9275     PetscInt       i;
9276 
9277     /* B0 and B0_B */
9278     if (zerodiag) {
9279       IS       dummy;
9280 
9281       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9282       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9283       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9284       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9285     }
9286     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9287     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9288     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9289     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9290     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9291     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9292     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9293     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9294     /* S_j */
9295     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9296     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9297 
9298     /* mimic vector in \widetilde{W}_\Gamma */
9299     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9300     /* continuous in primal space */
9301     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9302     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9303     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9304     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9305     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9306     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9307     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9308     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9309     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9310     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9311     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9312     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9313     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9314     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9315 
9316     /* assemble rhs for coarse problem */
9317     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9318     /* local with Schur */
9319     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9320     if (zerodiag) {
9321       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9322       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9323       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9324       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9325     }
9326     /* sum on primal nodes the local contributions */
9327     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9328     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9329     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9330     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9331     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9332     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9333     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9334     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9335     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9336     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9337     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9338     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9339     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9340     /* scale primal nodes (BDDC sums contibutions) */
9341     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9342     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9343     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9344     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9345     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9346     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9347     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9348     /* global: \widetilde{B0}_B w_\Gamma */
9349     if (zerodiag) {
9350       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9351       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9352       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9353       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9354     }
9355     /* BDDC */
9356     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9357     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9358 
9359     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9360     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9361     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9362     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9363     for (i=0;i<pcbddc->benign_n;i++) {
9364       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);
9365     }
9366     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9367     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9368     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9369     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9370     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9371     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9372   }
9373   PetscFunctionReturn(0);
9374 }
9375 
9376 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9377 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9378 {
9379   Mat            At;
9380   IS             rows;
9381   PetscInt       rst,ren;
9382   PetscErrorCode ierr;
9383   PetscLayout    rmap;
9384 
9385   PetscFunctionBegin;
9386   rst = ren = 0;
9387   if (ccomm != MPI_COMM_NULL) {
9388     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9389     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9390     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9391     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9392     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9393   }
9394   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9395   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9396   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9397 
9398   if (ccomm != MPI_COMM_NULL) {
9399     Mat_MPIAIJ *a,*b;
9400     IS         from,to;
9401     Vec        gvec;
9402     PetscInt   lsize;
9403 
9404     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9405     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9406     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9407     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9408     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9409     a    = (Mat_MPIAIJ*)At->data;
9410     b    = (Mat_MPIAIJ*)(*B)->data;
9411     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9412     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9413     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9414     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9415     b->A = a->A;
9416     b->B = a->B;
9417 
9418     b->donotstash      = a->donotstash;
9419     b->roworiented     = a->roworiented;
9420     b->rowindices      = NULL;
9421     b->rowvalues       = NULL;
9422     b->getrowactive    = PETSC_FALSE;
9423 
9424     (*B)->rmap         = rmap;
9425     (*B)->factortype   = A->factortype;
9426     (*B)->assembled    = PETSC_TRUE;
9427     (*B)->insertmode   = NOT_SET_VALUES;
9428     (*B)->preallocated = PETSC_TRUE;
9429 
9430     if (a->colmap) {
9431 #if defined(PETSC_USE_CTABLE)
9432       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9433 #else
9434       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9435       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9436       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9437 #endif
9438     } else b->colmap = NULL;
9439     if (a->garray) {
9440       PetscInt len;
9441       len  = a->B->cmap->n;
9442       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9443       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9444       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9445     } else b->garray = NULL;
9446 
9447     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9448     b->lvec = a->lvec;
9449     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9450 
9451     /* cannot use VecScatterCopy */
9452     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9453     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9454     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9455     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9456     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9457     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9458     ierr = ISDestroy(&from);CHKERRQ(ierr);
9459     ierr = ISDestroy(&to);CHKERRQ(ierr);
9460     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9461   }
9462   ierr = MatDestroy(&At);CHKERRQ(ierr);
9463   PetscFunctionReturn(0);
9464 }
9465