xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 13e56cb6cb65da8be7a503a952c6270e66907b59)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat               GEc;
121     const PetscScalar *vals;
122     PetscScalar       v;
123 
124     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
125     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
126     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
127     /* v    = PetscAbsScalar(vals[0]) */;
128     v    = 1.;
129     cvals[0] = vals[0]/v;
130     cvals[1] = vals[1]/v;
131     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
132     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
133 #if defined(PRINT_GDET)
134     {
135       PetscViewer viewer;
136       char filename[256];
137       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
138       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
139       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
141       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
142       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
143       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
144       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
145       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
146       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
147     }
148 #endif
149     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
150     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
151   }
152 
153   PetscFunctionReturn(0);
154 }
155 
156 PetscErrorCode PCBDDCNedelecSupport(PC pc)
157 {
158   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
159   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
160   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
161   Vec                    tvec;
162   PetscSF                sfv;
163   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
164   MPI_Comm               comm;
165   IS                     lned,primals,allprimals,nedfieldlocal;
166   IS                     *eedges,*extrows,*extcols,*alleedges;
167   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
168   PetscScalar            *vals,*work;
169   PetscReal              *rwork;
170   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
171   PetscInt               ne,nv,Lv,order,n,field;
172   PetscInt               n_neigh,*neigh,*n_shared,**shared;
173   PetscInt               i,j,extmem,cum,maxsize,nee;
174   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
175   PetscInt               *sfvleaves,*sfvroots;
176   PetscInt               *corners,*cedges;
177   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
178 #if defined(PETSC_USE_DEBUG)
179   PetscInt               *emarks;
180 #endif
181   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
182   PetscErrorCode         ierr;
183 
184   PetscFunctionBegin;
185   /* If the discrete gradient is defined for a subset of dofs and global is true,
186      it assumes G is given in global ordering for all the dofs.
187      Otherwise, the ordering is global for the Nedelec field */
188   order      = pcbddc->nedorder;
189   conforming = pcbddc->conforming;
190   field      = pcbddc->nedfield;
191   global     = pcbddc->nedglobal;
192   setprimal  = PETSC_FALSE;
193   print      = PETSC_FALSE;
194   singular   = PETSC_FALSE;
195 
196   /* Command line customization */
197   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
201   /* print debug info TODO: to be removed */
202   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
203   ierr = PetscOptionsEnd();CHKERRQ(ierr);
204 
205   /* Return if there are no edges in the decomposition and the problem is not singular */
206   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
207   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
208   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
209   if (!singular) {
210     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
211     lrc[0] = PETSC_FALSE;
212     for (i=0;i<n;i++) {
213       if (PetscRealPart(vals[i]) > 2.) {
214         lrc[0] = PETSC_TRUE;
215         break;
216       }
217     }
218     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
219     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
220     if (!lrc[1]) PetscFunctionReturn(0);
221   }
222 
223   /* Get Nedelec field */
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %D: number of fields is %D",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
237     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %D it's not a multiple of the order %D",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
324   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %D connected with nodal dof %D with order %D",test,i,ord);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
638   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
836       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %D: mark %D (ref mark %D), boundary %D\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %D and %D) connected through the %D nodal dof at edge dof %D",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1183     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       const PetscScalar *data;
1281       const PetscInt    *rows,*cols;
1282       PetscInt          nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %D and Gins %D does not match %D for coarse edge %D",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %D with ncc %D",i,ncc);
1297       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize,*gidxs;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1491   }
1492 
1493   /* compute local quad vec */
1494   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1495   if (!transpose) {
1496     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1497   } else {
1498     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1499   }
1500   ierr = VecSet(p,1.);CHKERRQ(ierr);
1501   if (!transpose) {
1502     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1503   } else {
1504     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1505   }
1506   if (vl2l) {
1507     Mat        lA;
1508     VecScatter sc;
1509 
1510     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1511     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1512     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1513     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1516   } else {
1517     vins = v;
1518   }
1519   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1520   ierr = VecDestroy(&p);CHKERRQ(ierr);
1521 
1522   /* insert in global quadrature vecs */
1523   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1524   for (i=0;i<n_neigh;i++) {
1525     const PetscInt    *idxs;
1526     PetscInt          idx,nn,j;
1527 
1528     idxs = shared[i];
1529     nn   = n_shared[i];
1530     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1531     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1532     idx  = -(idx+1);
1533     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1534     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   ierr = VecBindToCPU(global,PETSC_TRUE);CHKERRQ(ierr);
1605   ierr = VecBindToCPU(local,PETSC_TRUE);CHKERRQ(ierr);
1606   if (monolithic) { /* just get block size to properly compute vertices */
1607     if (pcbddc->vertex_size == 1) {
1608       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1609     }
1610     goto boundary;
1611   }
1612 
1613   if (pcbddc->user_provided_isfordofs) {
1614     if (pcbddc->n_ISForDofs) {
1615       PetscInt i;
1616 
1617       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1618       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1619         PetscInt bs;
1620 
1621         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1622         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1623         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1624         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1625       }
1626       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1627       pcbddc->n_ISForDofs = 0;
1628       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1629     }
1630   } else {
1631     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1632       DM dm;
1633 
1634       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1635       if (!dm) {
1636         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1637       }
1638       if (dm) {
1639         IS      *fields;
1640         PetscInt nf,i;
1641 
1642         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1643         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1644         for (i=0;i<nf;i++) {
1645           PetscInt bs;
1646 
1647           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1648           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1649           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1650           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1651         }
1652         ierr = PetscFree(fields);CHKERRQ(ierr);
1653         pcbddc->n_ISForDofsLocal = nf;
1654       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1655         PetscContainer   c;
1656 
1657         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1658         if (c) {
1659           MatISLocalFields lf;
1660           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1661           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1662         } else { /* fallback, create the default fields if bs > 1 */
1663           PetscInt i, n = matis->A->rmap->n;
1664           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1665           if (i > 1) {
1666             pcbddc->n_ISForDofsLocal = i;
1667             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1668             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1669               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1670             }
1671           }
1672         }
1673       }
1674     } else {
1675       PetscInt i;
1676       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1677         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1678       }
1679     }
1680   }
1681 
1682 boundary:
1683   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1684     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1685   } else if (pcbddc->DirichletBoundariesLocal) {
1686     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1687   }
1688   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1689     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1690   } else if (pcbddc->NeumannBoundariesLocal) {
1691     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1692   }
1693   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1694     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1695   }
1696   ierr = VecDestroy(&global);CHKERRQ(ierr);
1697   ierr = VecDestroy(&local);CHKERRQ(ierr);
1698   /* detect local disconnected subdomains if requested (use matis->A) */
1699   if (pcbddc->detect_disconnected) {
1700     IS        primalv = NULL;
1701     PetscInt  i;
1702     PetscBool filter = pcbddc->detect_disconnected_filter;
1703 
1704     for (i=0;i<pcbddc->n_local_subs;i++) {
1705       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1706     }
1707     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1708     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1709     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1710     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1711   }
1712   /* early stage corner detection */
1713   {
1714     DM dm;
1715 
1716     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1717     if (!dm) {
1718       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1719     }
1720     if (dm) {
1721       PetscBool isda;
1722 
1723       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1724       if (isda) {
1725         ISLocalToGlobalMapping l2l;
1726         IS                     corners;
1727         Mat                    lA;
1728         PetscBool              gl,lo;
1729 
1730         {
1731           Vec               cvec;
1732           const PetscScalar *coords;
1733           PetscInt          dof,n,cdim;
1734           PetscBool         memc = PETSC_TRUE;
1735 
1736           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1737           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1738           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1739           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1740           n   /= cdim;
1741           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1742           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1743           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1744 #if defined(PETSC_USE_COMPLEX)
1745           memc = PETSC_FALSE;
1746 #endif
1747           if (dof != 1) memc = PETSC_FALSE;
1748           if (memc) {
1749             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1750           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1751             PetscReal *bcoords = pcbddc->mat_graph->coords;
1752             PetscInt  i, b, d;
1753 
1754             for (i=0;i<n;i++) {
1755               for (b=0;b<dof;b++) {
1756                 for (d=0;d<cdim;d++) {
1757                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1758                 }
1759               }
1760             }
1761           }
1762           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1763           pcbddc->mat_graph->cdim  = cdim;
1764           pcbddc->mat_graph->cnloc = dof*n;
1765           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1766         }
1767         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1768         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1769         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1770         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1771         lo   = (PetscBool)(l2l && corners);
1772         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1773         if (gl) { /* From PETSc's DMDA */
1774           const PetscInt    *idx;
1775           PetscInt          dof,bs,*idxout,n;
1776 
1777           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1778           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1779           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1780           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1781           if (bs == dof) {
1782             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1783             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1784           } else { /* the original DMDA local-to-local map have been modified */
1785             PetscInt i,d;
1786 
1787             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1788             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1789             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1790 
1791             bs = 1;
1792             n *= dof;
1793           }
1794           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1795           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1796           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1797           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1798           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1799           pcbddc->corner_selected  = PETSC_TRUE;
1800           pcbddc->corner_selection = PETSC_TRUE;
1801         }
1802         if (corners) {
1803           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1804         }
1805       }
1806     }
1807   }
1808   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1809     DM dm;
1810 
1811     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1812     if (!dm) {
1813       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1814     }
1815     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1816       Vec            vcoords;
1817       PetscSection   section;
1818       PetscReal      *coords;
1819       PetscInt       d,cdim,nl,nf,**ctxs;
1820       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1821 
1822       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1823       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1824       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1825       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1826       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1827       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1828       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1829       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1830       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1831       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1832       for (d=0;d<cdim;d++) {
1833         PetscInt          i;
1834         const PetscScalar *v;
1835 
1836         for (i=0;i<nf;i++) ctxs[i][0] = d;
1837         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1838         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1839         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1840         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1841       }
1842       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1843       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1844       ierr = PetscFree(coords);CHKERRQ(ierr);
1845       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1846       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1847     }
1848   }
1849   PetscFunctionReturn(0);
1850 }
1851 
1852 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1853 {
1854   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1855   PetscErrorCode  ierr;
1856   IS              nis;
1857   const PetscInt  *idxs;
1858   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1859   PetscBool       *ld;
1860 
1861   PetscFunctionBegin;
1862   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1863   if (mop == MPI_LAND) {
1864     /* init rootdata with true */
1865     ld   = (PetscBool*) matis->sf_rootdata;
1866     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1867   } else {
1868     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1869   }
1870   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1871   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1872   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1873   ld   = (PetscBool*) matis->sf_leafdata;
1874   for (i=0;i<nd;i++)
1875     if (-1 < idxs[i] && idxs[i] < n)
1876       ld[idxs[i]] = PETSC_TRUE;
1877   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1878   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1879   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1880   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1881   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1882   if (mop == MPI_LAND) {
1883     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1884   } else {
1885     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1886   }
1887   for (i=0,nnd=0;i<n;i++)
1888     if (ld[i])
1889       nidxs[nnd++] = i;
1890   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1891   ierr = ISDestroy(is);CHKERRQ(ierr);
1892   *is  = nis;
1893   PetscFunctionReturn(0);
1894 }
1895 
1896 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1897 {
1898   PC_IS             *pcis = (PC_IS*)(pc->data);
1899   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1900   PetscErrorCode    ierr;
1901 
1902   PetscFunctionBegin;
1903   if (!pcbddc->benign_have_null) {
1904     PetscFunctionReturn(0);
1905   }
1906   if (pcbddc->ChangeOfBasisMatrix) {
1907     Vec swap;
1908 
1909     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1910     swap = pcbddc->work_change;
1911     pcbddc->work_change = r;
1912     r = swap;
1913   }
1914   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1915   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1916   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1917   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1918   ierr = VecSet(z,0.);CHKERRQ(ierr);
1919   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1920   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1921   if (pcbddc->ChangeOfBasisMatrix) {
1922     pcbddc->work_change = r;
1923     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1924     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1925   }
1926   PetscFunctionReturn(0);
1927 }
1928 
1929 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1930 {
1931   PCBDDCBenignMatMult_ctx ctx;
1932   PetscErrorCode          ierr;
1933   PetscBool               apply_right,apply_left,reset_x;
1934 
1935   PetscFunctionBegin;
1936   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1937   if (transpose) {
1938     apply_right = ctx->apply_left;
1939     apply_left = ctx->apply_right;
1940   } else {
1941     apply_right = ctx->apply_right;
1942     apply_left = ctx->apply_left;
1943   }
1944   reset_x = PETSC_FALSE;
1945   if (apply_right) {
1946     const PetscScalar *ax;
1947     PetscInt          nl,i;
1948 
1949     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1950     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1951     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1952     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1953     for (i=0;i<ctx->benign_n;i++) {
1954       PetscScalar    sum,val;
1955       const PetscInt *idxs;
1956       PetscInt       nz,j;
1957       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1958       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1959       sum = 0.;
1960       if (ctx->apply_p0) {
1961         val = ctx->work[idxs[nz-1]];
1962         for (j=0;j<nz-1;j++) {
1963           sum += ctx->work[idxs[j]];
1964           ctx->work[idxs[j]] += val;
1965         }
1966       } else {
1967         for (j=0;j<nz-1;j++) {
1968           sum += ctx->work[idxs[j]];
1969         }
1970       }
1971       ctx->work[idxs[nz-1]] -= sum;
1972       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1973     }
1974     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1975     reset_x = PETSC_TRUE;
1976   }
1977   if (transpose) {
1978     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1979   } else {
1980     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1981   }
1982   if (reset_x) {
1983     ierr = VecResetArray(x);CHKERRQ(ierr);
1984   }
1985   if (apply_left) {
1986     PetscScalar *ay;
1987     PetscInt    i;
1988 
1989     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1990     for (i=0;i<ctx->benign_n;i++) {
1991       PetscScalar    sum,val;
1992       const PetscInt *idxs;
1993       PetscInt       nz,j;
1994       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1995       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1996       val = -ay[idxs[nz-1]];
1997       if (ctx->apply_p0) {
1998         sum = 0.;
1999         for (j=0;j<nz-1;j++) {
2000           sum += ay[idxs[j]];
2001           ay[idxs[j]] += val;
2002         }
2003         ay[idxs[nz-1]] += sum;
2004       } else {
2005         for (j=0;j<nz-1;j++) {
2006           ay[idxs[j]] += val;
2007         }
2008         ay[idxs[nz-1]] = 0.;
2009       }
2010       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2011     }
2012     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2013   }
2014   PetscFunctionReturn(0);
2015 }
2016 
2017 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2018 {
2019   PetscErrorCode ierr;
2020 
2021   PetscFunctionBegin;
2022   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2023   PetscFunctionReturn(0);
2024 }
2025 
2026 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2027 {
2028   PetscErrorCode ierr;
2029 
2030   PetscFunctionBegin;
2031   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2032   PetscFunctionReturn(0);
2033 }
2034 
2035 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2036 {
2037   PC_IS                   *pcis = (PC_IS*)pc->data;
2038   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2039   PCBDDCBenignMatMult_ctx ctx;
2040   PetscErrorCode          ierr;
2041 
2042   PetscFunctionBegin;
2043   if (!restore) {
2044     Mat                A_IB,A_BI;
2045     PetscScalar        *work;
2046     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2047 
2048     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2049     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2050     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2051     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2052     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2053     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2054     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2055     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2056     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2057     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2058     ctx->apply_left = PETSC_TRUE;
2059     ctx->apply_right = PETSC_FALSE;
2060     ctx->apply_p0 = PETSC_FALSE;
2061     ctx->benign_n = pcbddc->benign_n;
2062     if (reuse) {
2063       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2064       ctx->free = PETSC_FALSE;
2065     } else { /* TODO: could be optimized for successive solves */
2066       ISLocalToGlobalMapping N_to_D;
2067       PetscInt               i;
2068 
2069       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2070       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2071       for (i=0;i<pcbddc->benign_n;i++) {
2072         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2073       }
2074       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2075       ctx->free = PETSC_TRUE;
2076     }
2077     ctx->A = pcis->A_IB;
2078     ctx->work = work;
2079     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2080     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2081     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2082     pcis->A_IB = A_IB;
2083 
2084     /* A_BI as A_IB^T */
2085     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2086     pcbddc->benign_original_mat = pcis->A_BI;
2087     pcis->A_BI = A_BI;
2088   } else {
2089     if (!pcbddc->benign_original_mat) {
2090       PetscFunctionReturn(0);
2091     }
2092     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2093     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2094     pcis->A_IB = ctx->A;
2095     ctx->A = NULL;
2096     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2097     pcis->A_BI = pcbddc->benign_original_mat;
2098     pcbddc->benign_original_mat = NULL;
2099     if (ctx->free) {
2100       PetscInt i;
2101       for (i=0;i<ctx->benign_n;i++) {
2102         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2103       }
2104       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2105     }
2106     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2107     ierr = PetscFree(ctx);CHKERRQ(ierr);
2108   }
2109   PetscFunctionReturn(0);
2110 }
2111 
2112 /* used just in bddc debug mode */
2113 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2114 {
2115   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2116   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2117   Mat            An;
2118   PetscErrorCode ierr;
2119 
2120   PetscFunctionBegin;
2121   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2122   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2123   if (is1) {
2124     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2125     ierr = MatDestroy(&An);CHKERRQ(ierr);
2126   } else {
2127     *B = An;
2128   }
2129   PetscFunctionReturn(0);
2130 }
2131 
2132 /* TODO: add reuse flag */
2133 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2134 {
2135   Mat            Bt;
2136   PetscScalar    *a,*bdata;
2137   const PetscInt *ii,*ij;
2138   PetscInt       m,n,i,nnz,*bii,*bij;
2139   PetscBool      flg_row;
2140   PetscErrorCode ierr;
2141 
2142   PetscFunctionBegin;
2143   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2144   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2145   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2146   nnz = n;
2147   for (i=0;i<ii[n];i++) {
2148     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2149   }
2150   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2151   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2152   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2153   nnz = 0;
2154   bii[0] = 0;
2155   for (i=0;i<n;i++) {
2156     PetscInt j;
2157     for (j=ii[i];j<ii[i+1];j++) {
2158       PetscScalar entry = a[j];
2159       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2160         bij[nnz] = ij[j];
2161         bdata[nnz] = entry;
2162         nnz++;
2163       }
2164     }
2165     bii[i+1] = nnz;
2166   }
2167   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2168   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2169   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2170   {
2171     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2172     b->free_a = PETSC_TRUE;
2173     b->free_ij = PETSC_TRUE;
2174   }
2175   if (*B == A) {
2176     ierr = MatDestroy(&A);CHKERRQ(ierr);
2177   }
2178   *B = Bt;
2179   PetscFunctionReturn(0);
2180 }
2181 
2182 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2183 {
2184   Mat                    B = NULL;
2185   DM                     dm;
2186   IS                     is_dummy,*cc_n;
2187   ISLocalToGlobalMapping l2gmap_dummy;
2188   PCBDDCGraph            graph;
2189   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2190   PetscInt               i,n;
2191   PetscInt               *xadj,*adjncy;
2192   PetscBool              isplex = PETSC_FALSE;
2193   PetscErrorCode         ierr;
2194 
2195   PetscFunctionBegin;
2196   if (ncc) *ncc = 0;
2197   if (cc) *cc = NULL;
2198   if (primalv) *primalv = NULL;
2199   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2200   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2201   if (!dm) {
2202     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2203   }
2204   if (dm) {
2205     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2206   }
2207   if (filter) isplex = PETSC_FALSE;
2208 
2209   if (isplex) { /* this code has been modified from plexpartition.c */
2210     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2211     PetscInt      *adj = NULL;
2212     IS             cellNumbering;
2213     const PetscInt *cellNum;
2214     PetscBool      useCone, useClosure;
2215     PetscSection   section;
2216     PetscSegBuffer adjBuffer;
2217     PetscSF        sfPoint;
2218     PetscErrorCode ierr;
2219 
2220     PetscFunctionBegin;
2221     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2222     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2223     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2224     /* Build adjacency graph via a section/segbuffer */
2225     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2226     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2227     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2228     /* Always use FVM adjacency to create partitioner graph */
2229     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2230     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2231     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2232     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2233     for (n = 0, p = pStart; p < pEnd; p++) {
2234       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2235       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2236       adjSize = PETSC_DETERMINE;
2237       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2238       for (a = 0; a < adjSize; ++a) {
2239         const PetscInt point = adj[a];
2240         if (pStart <= point && point < pEnd) {
2241           PetscInt *PETSC_RESTRICT pBuf;
2242           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2243           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2244           *pBuf = point;
2245         }
2246       }
2247       n++;
2248     }
2249     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2250     /* Derive CSR graph from section/segbuffer */
2251     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2252     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2253     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2254     for (idx = 0, p = pStart; p < pEnd; p++) {
2255       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2256       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2257     }
2258     xadj[n] = size;
2259     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2260     /* Clean up */
2261     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2262     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2263     ierr = PetscFree(adj);CHKERRQ(ierr);
2264     graph->xadj = xadj;
2265     graph->adjncy = adjncy;
2266   } else {
2267     Mat       A;
2268     PetscBool isseqaij, flg_row;
2269 
2270     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2271     if (!A->rmap->N || !A->cmap->N) {
2272       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2273       PetscFunctionReturn(0);
2274     }
2275     ierr = PetscObjectBaseTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2276     if (!isseqaij && filter) {
2277       PetscBool isseqdense;
2278 
2279       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2280       if (!isseqdense) {
2281         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2282       } else { /* TODO: rectangular case and LDA */
2283         PetscScalar *array;
2284         PetscReal   chop=1.e-6;
2285 
2286         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2287         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2288         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2289         for (i=0;i<n;i++) {
2290           PetscInt j;
2291           for (j=i+1;j<n;j++) {
2292             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2293             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2294             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2295           }
2296         }
2297         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2298         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2299       }
2300     } else {
2301       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2302       B = A;
2303     }
2304     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2305 
2306     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2307     if (filter) {
2308       PetscScalar *data;
2309       PetscInt    j,cum;
2310 
2311       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2312       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2313       cum = 0;
2314       for (i=0;i<n;i++) {
2315         PetscInt t;
2316 
2317         for (j=xadj[i];j<xadj[i+1];j++) {
2318           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2319             continue;
2320           }
2321           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2322         }
2323         t = xadj_filtered[i];
2324         xadj_filtered[i] = cum;
2325         cum += t;
2326       }
2327       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2328       graph->xadj = xadj_filtered;
2329       graph->adjncy = adjncy_filtered;
2330     } else {
2331       graph->xadj = xadj;
2332       graph->adjncy = adjncy;
2333     }
2334   }
2335   /* compute local connected components using PCBDDCGraph */
2336   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2337   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2338   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2339   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2340   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2341   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2342   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2343 
2344   /* partial clean up */
2345   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2346   if (B) {
2347     PetscBool flg_row;
2348     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2349     ierr = MatDestroy(&B);CHKERRQ(ierr);
2350   }
2351   if (isplex) {
2352     ierr = PetscFree(xadj);CHKERRQ(ierr);
2353     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2354   }
2355 
2356   /* get back data */
2357   if (isplex) {
2358     if (ncc) *ncc = graph->ncc;
2359     if (cc || primalv) {
2360       Mat          A;
2361       PetscBT      btv,btvt;
2362       PetscSection subSection;
2363       PetscInt     *ids,cum,cump,*cids,*pids;
2364 
2365       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2366       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2367       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2368       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2369       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2370 
2371       cids[0] = 0;
2372       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2373         PetscInt j;
2374 
2375         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2376         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2377           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2378 
2379           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2380           for (k = 0; k < 2*size; k += 2) {
2381             PetscInt s, pp, p = closure[k], off, dof, cdof;
2382 
2383             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2384             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2385             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2386             for (s = 0; s < dof-cdof; s++) {
2387               if (PetscBTLookupSet(btvt,off+s)) continue;
2388               if (!PetscBTLookup(btv,off+s)) {
2389                 ids[cum++] = off+s;
2390               } else { /* cross-vertex */
2391                 pids[cump++] = off+s;
2392               }
2393             }
2394             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2395             if (pp != p) {
2396               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2397               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2398               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2399               for (s = 0; s < dof-cdof; s++) {
2400                 if (PetscBTLookupSet(btvt,off+s)) continue;
2401                 if (!PetscBTLookup(btv,off+s)) {
2402                   ids[cum++] = off+s;
2403                 } else { /* cross-vertex */
2404                   pids[cump++] = off+s;
2405                 }
2406               }
2407             }
2408           }
2409           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2410         }
2411         cids[i+1] = cum;
2412         /* mark dofs as already assigned */
2413         for (j = cids[i]; j < cids[i+1]; j++) {
2414           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2415         }
2416       }
2417       if (cc) {
2418         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2419         for (i = 0; i < graph->ncc; i++) {
2420           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2421         }
2422         *cc = cc_n;
2423       }
2424       if (primalv) {
2425         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2426       }
2427       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2428       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2429       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2430     }
2431   } else {
2432     if (ncc) *ncc = graph->ncc;
2433     if (cc) {
2434       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2435       for (i=0;i<graph->ncc;i++) {
2436         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);
2437       }
2438       *cc = cc_n;
2439     }
2440   }
2441   /* clean up graph */
2442   graph->xadj = 0;
2443   graph->adjncy = 0;
2444   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2445   PetscFunctionReturn(0);
2446 }
2447 
2448 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2449 {
2450   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2451   PC_IS*         pcis = (PC_IS*)(pc->data);
2452   IS             dirIS = NULL;
2453   PetscInt       i;
2454   PetscErrorCode ierr;
2455 
2456   PetscFunctionBegin;
2457   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2458   if (zerodiag) {
2459     Mat            A;
2460     Vec            vec3_N;
2461     PetscScalar    *vals;
2462     const PetscInt *idxs;
2463     PetscInt       nz,*count;
2464 
2465     /* p0 */
2466     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2467     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2468     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2469     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2470     for (i=0;i<nz;i++) vals[i] = 1.;
2471     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2472     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2473     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2474     /* v_I */
2475     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2476     for (i=0;i<nz;i++) vals[i] = 0.;
2477     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2478     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2479     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2480     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2481     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2482     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2483     if (dirIS) {
2484       PetscInt n;
2485 
2486       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2487       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2488       for (i=0;i<n;i++) vals[i] = 0.;
2489       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2490       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2491     }
2492     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2493     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2494     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2495     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2496     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2497     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2498     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2499     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]));
2500     ierr = PetscFree(vals);CHKERRQ(ierr);
2501     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2502 
2503     /* there should not be any pressure dofs lying on the interface */
2504     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2505     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2506     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2507     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2508     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2509     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]);
2510     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2511     ierr = PetscFree(count);CHKERRQ(ierr);
2512   }
2513   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2514 
2515   /* check PCBDDCBenignGetOrSetP0 */
2516   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2517   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2518   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2519   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2520   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2521   for (i=0;i<pcbddc->benign_n;i++) {
2522     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2523     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);
2524   }
2525   PetscFunctionReturn(0);
2526 }
2527 
2528 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2529 {
2530   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2531   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2532   PetscInt       nz,n,benign_n,bsp = 1;
2533   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2534   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2535   PetscErrorCode ierr;
2536 
2537   PetscFunctionBegin;
2538   if (reuse) goto project_b0;
2539   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2540   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2541   for (n=0;n<pcbddc->benign_n;n++) {
2542     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2543   }
2544   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2545   has_null_pressures = PETSC_TRUE;
2546   have_null = PETSC_TRUE;
2547   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2548      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2549      Checks if all the pressure dofs in each subdomain have a zero diagonal
2550      If not, a change of basis on pressures is not needed
2551      since the local Schur complements are already SPD
2552   */
2553   if (pcbddc->n_ISForDofsLocal) {
2554     IS        iP = NULL;
2555     PetscInt  p,*pp;
2556     PetscBool flg;
2557 
2558     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2559     n    = pcbddc->n_ISForDofsLocal;
2560     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2561     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2562     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2563     if (!flg) {
2564       n = 1;
2565       pp[0] = pcbddc->n_ISForDofsLocal-1;
2566     }
2567 
2568     bsp = 0;
2569     for (p=0;p<n;p++) {
2570       PetscInt bs;
2571 
2572       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]);
2573       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2574       bsp += bs;
2575     }
2576     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2577     bsp  = 0;
2578     for (p=0;p<n;p++) {
2579       const PetscInt *idxs;
2580       PetscInt       b,bs,npl,*bidxs;
2581 
2582       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2583       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2584       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2585       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2586       for (b=0;b<bs;b++) {
2587         PetscInt i;
2588 
2589         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2590         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2591         bsp++;
2592       }
2593       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2594       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2595     }
2596     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2597 
2598     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2599     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2600     if (iP) {
2601       IS newpressures;
2602 
2603       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2604       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2605       pressures = newpressures;
2606     }
2607     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2608     if (!sorted) {
2609       ierr = ISSort(pressures);CHKERRQ(ierr);
2610     }
2611     ierr = PetscFree(pp);CHKERRQ(ierr);
2612   }
2613 
2614   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2615   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2616   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2617   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2618   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2619   if (!sorted) {
2620     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2621   }
2622   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2623   zerodiag_save = zerodiag;
2624   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2625   if (!nz) {
2626     if (n) have_null = PETSC_FALSE;
2627     has_null_pressures = PETSC_FALSE;
2628     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2629   }
2630   recompute_zerodiag = PETSC_FALSE;
2631 
2632   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2633   zerodiag_subs    = NULL;
2634   benign_n         = 0;
2635   n_interior_dofs  = 0;
2636   interior_dofs    = NULL;
2637   nneu             = 0;
2638   if (pcbddc->NeumannBoundariesLocal) {
2639     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2640   }
2641   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2642   if (checkb) { /* need to compute interior nodes */
2643     PetscInt n,i,j;
2644     PetscInt n_neigh,*neigh,*n_shared,**shared;
2645     PetscInt *iwork;
2646 
2647     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2648     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2649     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2650     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2651     for (i=1;i<n_neigh;i++)
2652       for (j=0;j<n_shared[i];j++)
2653           iwork[shared[i][j]] += 1;
2654     for (i=0;i<n;i++)
2655       if (!iwork[i])
2656         interior_dofs[n_interior_dofs++] = i;
2657     ierr = PetscFree(iwork);CHKERRQ(ierr);
2658     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2659   }
2660   if (has_null_pressures) {
2661     IS             *subs;
2662     PetscInt       nsubs,i,j,nl;
2663     const PetscInt *idxs;
2664     PetscScalar    *array;
2665     Vec            *work;
2666     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2667 
2668     subs  = pcbddc->local_subs;
2669     nsubs = pcbddc->n_local_subs;
2670     /* 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) */
2671     if (checkb) {
2672       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2673       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2674       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2675       /* work[0] = 1_p */
2676       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2677       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2678       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2679       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2680       /* work[0] = 1_v */
2681       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2682       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2683       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2684       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2685       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2686     }
2687 
2688     if (nsubs > 1 || bsp > 1) {
2689       IS       *is;
2690       PetscInt b,totb;
2691 
2692       totb  = bsp;
2693       is    = bsp > 1 ? bzerodiag : &zerodiag;
2694       nsubs = PetscMax(nsubs,1);
2695       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2696       for (b=0;b<totb;b++) {
2697         for (i=0;i<nsubs;i++) {
2698           ISLocalToGlobalMapping l2g;
2699           IS                     t_zerodiag_subs;
2700           PetscInt               nl;
2701 
2702           if (subs) {
2703             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2704           } else {
2705             IS tis;
2706 
2707             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2708             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2709             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2710             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2711           }
2712           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2713           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2714           if (nl) {
2715             PetscBool valid = PETSC_TRUE;
2716 
2717             if (checkb) {
2718               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2719               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2720               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2721               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2722               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2723               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2724               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2725               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2726               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2727               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2728               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2729               for (j=0;j<n_interior_dofs;j++) {
2730                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2731                   valid = PETSC_FALSE;
2732                   break;
2733                 }
2734               }
2735               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2736             }
2737             if (valid && nneu) {
2738               const PetscInt *idxs;
2739               PetscInt       nzb;
2740 
2741               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2742               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2743               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2744               if (nzb) valid = PETSC_FALSE;
2745             }
2746             if (valid && pressures) {
2747               IS       t_pressure_subs,tmp;
2748               PetscInt i1,i2;
2749 
2750               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2751               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2752               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2753               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2754               if (i2 != i1) valid = PETSC_FALSE;
2755               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2756               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2757             }
2758             if (valid) {
2759               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2760               benign_n++;
2761             } else recompute_zerodiag = PETSC_TRUE;
2762           }
2763           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2764           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2765         }
2766       }
2767     } else { /* there's just one subdomain (or zero if they have not been detected */
2768       PetscBool valid = PETSC_TRUE;
2769 
2770       if (nneu) valid = PETSC_FALSE;
2771       if (valid && pressures) {
2772         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2773       }
2774       if (valid && checkb) {
2775         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2776         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2777         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2778         for (j=0;j<n_interior_dofs;j++) {
2779           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2780             valid = PETSC_FALSE;
2781             break;
2782           }
2783         }
2784         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2785       }
2786       if (valid) {
2787         benign_n = 1;
2788         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2789         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2790         zerodiag_subs[0] = zerodiag;
2791       }
2792     }
2793     if (checkb) {
2794       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2795     }
2796   }
2797   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2798 
2799   if (!benign_n) {
2800     PetscInt n;
2801 
2802     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2803     recompute_zerodiag = PETSC_FALSE;
2804     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2805     if (n) have_null = PETSC_FALSE;
2806   }
2807 
2808   /* final check for null pressures */
2809   if (zerodiag && pressures) {
2810     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2811   }
2812 
2813   if (recompute_zerodiag) {
2814     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2815     if (benign_n == 1) {
2816       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2817       zerodiag = zerodiag_subs[0];
2818     } else {
2819       PetscInt i,nzn,*new_idxs;
2820 
2821       nzn = 0;
2822       for (i=0;i<benign_n;i++) {
2823         PetscInt ns;
2824         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2825         nzn += ns;
2826       }
2827       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2828       nzn = 0;
2829       for (i=0;i<benign_n;i++) {
2830         PetscInt ns,*idxs;
2831         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2832         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2833         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2834         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2835         nzn += ns;
2836       }
2837       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2838       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2839     }
2840     have_null = PETSC_FALSE;
2841   }
2842 
2843   /* determines if the coarse solver will be singular or not */
2844   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2845 
2846   /* Prepare matrix to compute no-net-flux */
2847   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2848     Mat                    A,loc_divudotp;
2849     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2850     IS                     row,col,isused = NULL;
2851     PetscInt               M,N,n,st,n_isused;
2852 
2853     if (pressures) {
2854       isused = pressures;
2855     } else {
2856       isused = zerodiag_save;
2857     }
2858     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2859     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2860     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2861     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");
2862     n_isused = 0;
2863     if (isused) {
2864       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2865     }
2866     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2867     st = st-n_isused;
2868     if (n) {
2869       const PetscInt *gidxs;
2870 
2871       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2872       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2873       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2874       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2875       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2876       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2877     } else {
2878       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2879       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2880       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2881     }
2882     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2883     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2884     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2885     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2886     ierr = ISDestroy(&row);CHKERRQ(ierr);
2887     ierr = ISDestroy(&col);CHKERRQ(ierr);
2888     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2889     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2890     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2891     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2892     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2893     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2894     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2895     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2896     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2897     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2898   }
2899   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2900   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2901   if (bzerodiag) {
2902     PetscInt i;
2903 
2904     for (i=0;i<bsp;i++) {
2905       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2906     }
2907     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2908   }
2909   pcbddc->benign_n = benign_n;
2910   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2911 
2912   /* determines if the problem has subdomains with 0 pressure block */
2913   have_null = (PetscBool)(!!pcbddc->benign_n);
2914   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2915 
2916 project_b0:
2917   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2918   /* change of basis and p0 dofs */
2919   if (pcbddc->benign_n) {
2920     PetscInt i,s,*nnz;
2921 
2922     /* local change of basis for pressures */
2923     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2924     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2925     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2926     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2927     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2928     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2929     for (i=0;i<pcbddc->benign_n;i++) {
2930       const PetscInt *idxs;
2931       PetscInt       nzs,j;
2932 
2933       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2934       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2935       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2936       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2937       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2938     }
2939     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2940     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2941     ierr = PetscFree(nnz);CHKERRQ(ierr);
2942     /* set identity by default */
2943     for (i=0;i<n;i++) {
2944       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2945     }
2946     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2947     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2948     /* set change on pressures */
2949     for (s=0;s<pcbddc->benign_n;s++) {
2950       PetscScalar    *array;
2951       const PetscInt *idxs;
2952       PetscInt       nzs;
2953 
2954       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2955       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2956       for (i=0;i<nzs-1;i++) {
2957         PetscScalar vals[2];
2958         PetscInt    cols[2];
2959 
2960         cols[0] = idxs[i];
2961         cols[1] = idxs[nzs-1];
2962         vals[0] = 1.;
2963         vals[1] = 1.;
2964         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2965       }
2966       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2967       for (i=0;i<nzs-1;i++) array[i] = -1.;
2968       array[nzs-1] = 1.;
2969       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2970       /* store local idxs for p0 */
2971       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2972       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2973       ierr = PetscFree(array);CHKERRQ(ierr);
2974     }
2975     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2976     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2977 
2978     /* project if needed */
2979     if (pcbddc->benign_change_explicit) {
2980       Mat M;
2981 
2982       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2983       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2984       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2985       ierr = MatDestroy(&M);CHKERRQ(ierr);
2986     }
2987     /* store global idxs for p0 */
2988     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2989   }
2990   *zerodiaglocal = zerodiag;
2991   PetscFunctionReturn(0);
2992 }
2993 
2994 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2995 {
2996   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2997   PetscScalar    *array;
2998   PetscErrorCode ierr;
2999 
3000   PetscFunctionBegin;
3001   if (!pcbddc->benign_sf) {
3002     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3003     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3004   }
3005   if (get) {
3006     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3007     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3008     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3009     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3010   } else {
3011     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3012     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3013     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3014     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3015   }
3016   PetscFunctionReturn(0);
3017 }
3018 
3019 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3020 {
3021   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3022   PetscErrorCode ierr;
3023 
3024   PetscFunctionBegin;
3025   /* TODO: add error checking
3026     - avoid nested pop (or push) calls.
3027     - cannot push before pop.
3028     - cannot call this if pcbddc->local_mat is NULL
3029   */
3030   if (!pcbddc->benign_n) {
3031     PetscFunctionReturn(0);
3032   }
3033   if (pop) {
3034     if (pcbddc->benign_change_explicit) {
3035       IS       is_p0;
3036       MatReuse reuse;
3037 
3038       /* extract B_0 */
3039       reuse = MAT_INITIAL_MATRIX;
3040       if (pcbddc->benign_B0) {
3041         reuse = MAT_REUSE_MATRIX;
3042       }
3043       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3044       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3045       /* remove rows and cols from local problem */
3046       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3047       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3048       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3049       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3050     } else {
3051       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3052       PetscScalar *vals;
3053       PetscInt    i,n,*idxs_ins;
3054 
3055       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3056       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3057       if (!pcbddc->benign_B0) {
3058         PetscInt *nnz;
3059         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3060         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3061         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3062         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3063         for (i=0;i<pcbddc->benign_n;i++) {
3064           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3065           nnz[i] = n - nnz[i];
3066         }
3067         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3068         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3069         ierr = PetscFree(nnz);CHKERRQ(ierr);
3070       }
3071 
3072       for (i=0;i<pcbddc->benign_n;i++) {
3073         PetscScalar *array;
3074         PetscInt    *idxs,j,nz,cum;
3075 
3076         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3077         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3078         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3079         for (j=0;j<nz;j++) vals[j] = 1.;
3080         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3081         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3082         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3083         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3084         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3085         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3086         cum = 0;
3087         for (j=0;j<n;j++) {
3088           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3089             vals[cum] = array[j];
3090             idxs_ins[cum] = j;
3091             cum++;
3092           }
3093         }
3094         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3095         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3096         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3097       }
3098       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3099       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3100       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3101     }
3102   } else { /* push */
3103     if (pcbddc->benign_change_explicit) {
3104       PetscInt i;
3105 
3106       for (i=0;i<pcbddc->benign_n;i++) {
3107         PetscScalar *B0_vals;
3108         PetscInt    *B0_cols,B0_ncol;
3109 
3110         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3111         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3112         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3113         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3114         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3115       }
3116       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3117       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3118     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3119   }
3120   PetscFunctionReturn(0);
3121 }
3122 
3123 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3124 {
3125   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3126   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3127   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3128   PetscBLASInt    *B_iwork,*B_ifail;
3129   PetscScalar     *work,lwork;
3130   PetscScalar     *St,*S,*eigv;
3131   PetscScalar     *Sarray,*Starray;
3132   PetscReal       *eigs,thresh,lthresh,uthresh;
3133   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3134   PetscBool       allocated_S_St;
3135 #if defined(PETSC_USE_COMPLEX)
3136   PetscReal       *rwork;
3137 #endif
3138   PetscErrorCode  ierr;
3139 
3140   PetscFunctionBegin;
3141   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3142   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3143   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);
3144   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3145 
3146   if (pcbddc->dbg_flag) {
3147     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3148     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3149     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3150     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3151   }
3152 
3153   if (pcbddc->dbg_flag) {
3154     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);
3155   }
3156 
3157   /* max size of subsets */
3158   mss = 0;
3159   for (i=0;i<sub_schurs->n_subs;i++) {
3160     PetscInt subset_size;
3161 
3162     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3163     mss = PetscMax(mss,subset_size);
3164   }
3165 
3166   /* min/max and threshold */
3167   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3168   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3169   nmax = PetscMax(nmin,nmax);
3170   allocated_S_St = PETSC_FALSE;
3171   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3172     allocated_S_St = PETSC_TRUE;
3173   }
3174 
3175   /* allocate lapack workspace */
3176   cum = cum2 = 0;
3177   maxneigs = 0;
3178   for (i=0;i<sub_schurs->n_subs;i++) {
3179     PetscInt n,subset_size;
3180 
3181     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3182     n = PetscMin(subset_size,nmax);
3183     cum += subset_size;
3184     cum2 += subset_size*n;
3185     maxneigs = PetscMax(maxneigs,n);
3186   }
3187   lwork = 0;
3188   if (mss) {
3189     if (sub_schurs->is_symmetric) {
3190       PetscScalar  sdummy = 0.;
3191       PetscBLASInt B_itype = 1;
3192       PetscBLASInt B_N = mss, idummy = 0;
3193       PetscReal    rdummy = 0.,zero = 0.0;
3194       PetscReal    eps = 0.0; /* dlamch? */
3195 
3196       B_lwork = -1;
3197       /* some implementations may complain about NULL pointers, even if we are querying */
3198       S = &sdummy;
3199       St = &sdummy;
3200       eigs = &rdummy;
3201       eigv = &sdummy;
3202       B_iwork = &idummy;
3203       B_ifail = &idummy;
3204 #if defined(PETSC_USE_COMPLEX)
3205       rwork = &rdummy;
3206 #endif
3207       thresh = 1.0;
3208       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3209 #if defined(PETSC_USE_COMPLEX)
3210       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));
3211 #else
3212       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));
3213 #endif
3214       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3215       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3216     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3217   }
3218 
3219   nv = 0;
3220   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) */
3221     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3222   }
3223   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3224   if (allocated_S_St) {
3225     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3226   }
3227   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3228 #if defined(PETSC_USE_COMPLEX)
3229   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3230 #endif
3231   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3232                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3233                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3234                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3235                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3236   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3237 
3238   maxneigs = 0;
3239   cum = cumarray = 0;
3240   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3241   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3242   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3243     const PetscInt *idxs;
3244 
3245     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3246     for (cum=0;cum<nv;cum++) {
3247       pcbddc->adaptive_constraints_n[cum] = 1;
3248       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3249       pcbddc->adaptive_constraints_data[cum] = 1.0;
3250       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3251       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3252     }
3253     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3254   }
3255 
3256   if (mss) { /* multilevel */
3257     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3258     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3259   }
3260 
3261   lthresh = pcbddc->adaptive_threshold[0];
3262   uthresh = pcbddc->adaptive_threshold[1];
3263   for (i=0;i<sub_schurs->n_subs;i++) {
3264     const PetscInt *idxs;
3265     PetscReal      upper,lower;
3266     PetscInt       j,subset_size,eigs_start = 0;
3267     PetscBLASInt   B_N;
3268     PetscBool      same_data = PETSC_FALSE;
3269     PetscBool      scal = PETSC_FALSE;
3270 
3271     if (pcbddc->use_deluxe_scaling) {
3272       upper = PETSC_MAX_REAL;
3273       lower = uthresh;
3274     } else {
3275       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3276       upper = 1./uthresh;
3277       lower = 0.;
3278     }
3279     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3280     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3281     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3282     /* this is experimental: we assume the dofs have been properly grouped to have
3283        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3284     if (!sub_schurs->is_posdef) {
3285       Mat T;
3286 
3287       for (j=0;j<subset_size;j++) {
3288         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3289           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3290           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3291           ierr = MatDestroy(&T);CHKERRQ(ierr);
3292           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3293           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3294           ierr = MatDestroy(&T);CHKERRQ(ierr);
3295           if (sub_schurs->change_primal_sub) {
3296             PetscInt       nz,k;
3297             const PetscInt *idxs;
3298 
3299             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3300             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3301             for (k=0;k<nz;k++) {
3302               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3303               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3304             }
3305             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3306           }
3307           scal = PETSC_TRUE;
3308           break;
3309         }
3310       }
3311     }
3312 
3313     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3314       if (sub_schurs->is_symmetric) {
3315         PetscInt j,k;
3316         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3317           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3318           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3319         }
3320         for (j=0;j<subset_size;j++) {
3321           for (k=j;k<subset_size;k++) {
3322             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3323             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3324           }
3325         }
3326       } else {
3327         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3328         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3329       }
3330     } else {
3331       S = Sarray + cumarray;
3332       St = Starray + cumarray;
3333     }
3334     /* see if we can save some work */
3335     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3336       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3337     }
3338 
3339     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3340       B_neigs = 0;
3341     } else {
3342       if (sub_schurs->is_symmetric) {
3343         PetscBLASInt B_itype = 1;
3344         PetscBLASInt B_IL, B_IU;
3345         PetscReal    eps = -1.0; /* dlamch? */
3346         PetscInt     nmin_s;
3347         PetscBool    compute_range;
3348 
3349         B_neigs = 0;
3350         compute_range = (PetscBool)!same_data;
3351         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3352 
3353         if (pcbddc->dbg_flag) {
3354           PetscInt nc = 0;
3355 
3356           if (sub_schurs->change_primal_sub) {
3357             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3358           }
3359           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);
3360         }
3361 
3362         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3363         if (compute_range) {
3364 
3365           /* ask for eigenvalues larger than thresh */
3366           if (sub_schurs->is_posdef) {
3367 #if defined(PETSC_USE_COMPLEX)
3368             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));
3369 #else
3370             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));
3371 #endif
3372             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3373           } else { /* no theory so far, but it works nicely */
3374             PetscInt  recipe = 0,recipe_m = 1;
3375             PetscReal bb[2];
3376 
3377             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3378             switch (recipe) {
3379             case 0:
3380               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3381               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3382 #if defined(PETSC_USE_COMPLEX)
3383               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));
3384 #else
3385               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));
3386 #endif
3387               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3388               break;
3389             case 1:
3390               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3391 #if defined(PETSC_USE_COMPLEX)
3392               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));
3393 #else
3394               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));
3395 #endif
3396               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3397               if (!scal) {
3398                 PetscBLASInt B_neigs2 = 0;
3399 
3400                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3401                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3402                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3403 #if defined(PETSC_USE_COMPLEX)
3404                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3405 #else
3406                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3407 #endif
3408                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3409                 B_neigs += B_neigs2;
3410               }
3411               break;
3412             case 2:
3413               if (scal) {
3414                 bb[0] = PETSC_MIN_REAL;
3415                 bb[1] = 0;
3416 #if defined(PETSC_USE_COMPLEX)
3417                 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));
3418 #else
3419                 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));
3420 #endif
3421                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3422               } else {
3423                 PetscBLASInt B_neigs2 = 0;
3424                 PetscBool    import = PETSC_FALSE;
3425 
3426                 lthresh = PetscMax(lthresh,0.0);
3427                 if (lthresh > 0.0) {
3428                   bb[0] = PETSC_MIN_REAL;
3429                   bb[1] = lthresh*lthresh;
3430 
3431                   import = PETSC_TRUE;
3432 #if defined(PETSC_USE_COMPLEX)
3433                   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));
3434 #else
3435                   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));
3436 #endif
3437                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3438                 }
3439                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3440                 bb[1] = PETSC_MAX_REAL;
3441                 if (import) {
3442                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3443                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3444                 }
3445 #if defined(PETSC_USE_COMPLEX)
3446                 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));
3447 #else
3448                 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));
3449 #endif
3450                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3451                 B_neigs += B_neigs2;
3452               }
3453               break;
3454             case 3:
3455               if (scal) {
3456                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3457               } else {
3458                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3459               }
3460               if (!scal) {
3461                 bb[0] = uthresh;
3462                 bb[1] = PETSC_MAX_REAL;
3463 #if defined(PETSC_USE_COMPLEX)
3464                 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));
3465 #else
3466                 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));
3467 #endif
3468                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3469               }
3470               if (recipe_m > 0 && B_N - B_neigs > 0) {
3471                 PetscBLASInt B_neigs2 = 0;
3472 
3473                 B_IL = 1;
3474                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3475                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3476                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3477 #if defined(PETSC_USE_COMPLEX)
3478                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3479 #else
3480                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3481 #endif
3482                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3483                 B_neigs += B_neigs2;
3484               }
3485               break;
3486             case 4:
3487               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3488 #if defined(PETSC_USE_COMPLEX)
3489               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));
3490 #else
3491               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));
3492 #endif
3493               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3494               {
3495                 PetscBLASInt B_neigs2 = 0;
3496 
3497                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3498                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3499                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3500 #if defined(PETSC_USE_COMPLEX)
3501                 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));
3502 #else
3503                 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));
3504 #endif
3505                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3506                 B_neigs += B_neigs2;
3507               }
3508               break;
3509             case 5: /* same as before: first compute all eigenvalues, then filter */
3510 #if defined(PETSC_USE_COMPLEX)
3511               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));
3512 #else
3513               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));
3514 #endif
3515               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3516               {
3517                 PetscInt e,k,ne;
3518                 for (e=0,ne=0;e<B_neigs;e++) {
3519                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3520                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3521                     eigs[ne] = eigs[e];
3522                     ne++;
3523                   }
3524                 }
3525                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3526                 B_neigs = ne;
3527               }
3528               break;
3529             default:
3530               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3531               break;
3532             }
3533           }
3534         } else if (!same_data) { /* this is just to see all the eigenvalues */
3535           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3536           B_IL = 1;
3537 #if defined(PETSC_USE_COMPLEX)
3538           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));
3539 #else
3540           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));
3541 #endif
3542           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3543         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3544           PetscInt k;
3545           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3546           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3547           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3548           nmin = nmax;
3549           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3550           for (k=0;k<nmax;k++) {
3551             eigs[k] = 1./PETSC_SMALL;
3552             eigv[k*(subset_size+1)] = 1.0;
3553           }
3554         }
3555         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3556         if (B_ierr) {
3557           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3558           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);
3559           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);
3560         }
3561 
3562         if (B_neigs > nmax) {
3563           if (pcbddc->dbg_flag) {
3564             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3565           }
3566           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3567           B_neigs = nmax;
3568         }
3569 
3570         nmin_s = PetscMin(nmin,B_N);
3571         if (B_neigs < nmin_s) {
3572           PetscBLASInt B_neigs2 = 0;
3573 
3574           if (pcbddc->use_deluxe_scaling) {
3575             if (scal) {
3576               B_IU = nmin_s;
3577               B_IL = B_neigs + 1;
3578             } else {
3579               B_IL = B_N - nmin_s + 1;
3580               B_IU = B_N - B_neigs;
3581             }
3582           } else {
3583             B_IL = B_neigs + 1;
3584             B_IU = nmin_s;
3585           }
3586           if (pcbddc->dbg_flag) {
3587             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);
3588           }
3589           if (sub_schurs->is_symmetric) {
3590             PetscInt j,k;
3591             for (j=0;j<subset_size;j++) {
3592               for (k=j;k<subset_size;k++) {
3593                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3594                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3595               }
3596             }
3597           } else {
3598             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3599             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3600           }
3601           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3602 #if defined(PETSC_USE_COMPLEX)
3603           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));
3604 #else
3605           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));
3606 #endif
3607           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3608           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3609           B_neigs += B_neigs2;
3610         }
3611         if (B_ierr) {
3612           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3613           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);
3614           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);
3615         }
3616         if (pcbddc->dbg_flag) {
3617           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3618           for (j=0;j<B_neigs;j++) {
3619             if (eigs[j] == 0.0) {
3620               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3621             } else {
3622               if (pcbddc->use_deluxe_scaling) {
3623                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3624               } else {
3625                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3626               }
3627             }
3628           }
3629         }
3630       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3631     }
3632     /* change the basis back to the original one */
3633     if (sub_schurs->change) {
3634       Mat change,phi,phit;
3635 
3636       if (pcbddc->dbg_flag > 2) {
3637         PetscInt ii;
3638         for (ii=0;ii<B_neigs;ii++) {
3639           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3640           for (j=0;j<B_N;j++) {
3641 #if defined(PETSC_USE_COMPLEX)
3642             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3643             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3644             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3645 #else
3646             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3647 #endif
3648           }
3649         }
3650       }
3651       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3652       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3653       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3654       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3655       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3656       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3657     }
3658     maxneigs = PetscMax(B_neigs,maxneigs);
3659     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3660     if (B_neigs) {
3661       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3662 
3663       if (pcbddc->dbg_flag > 1) {
3664         PetscInt ii;
3665         for (ii=0;ii<B_neigs;ii++) {
3666           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3667           for (j=0;j<B_N;j++) {
3668 #if defined(PETSC_USE_COMPLEX)
3669             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3670             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3671             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3672 #else
3673             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3674 #endif
3675           }
3676         }
3677       }
3678       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3679       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3680       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3681       cum++;
3682     }
3683     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3684     /* shift for next computation */
3685     cumarray += subset_size*subset_size;
3686   }
3687   if (pcbddc->dbg_flag) {
3688     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3689   }
3690 
3691   if (mss) {
3692     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3693     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3694     /* destroy matrices (junk) */
3695     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3696     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3697   }
3698   if (allocated_S_St) {
3699     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3700   }
3701   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3702 #if defined(PETSC_USE_COMPLEX)
3703   ierr = PetscFree(rwork);CHKERRQ(ierr);
3704 #endif
3705   if (pcbddc->dbg_flag) {
3706     PetscInt maxneigs_r;
3707     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3708     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3709   }
3710   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3711   PetscFunctionReturn(0);
3712 }
3713 
3714 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3715 {
3716   PetscScalar    *coarse_submat_vals;
3717   PetscErrorCode ierr;
3718 
3719   PetscFunctionBegin;
3720   /* Setup local scatters R_to_B and (optionally) R_to_D */
3721   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3722   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3723 
3724   /* Setup local neumann solver ksp_R */
3725   /* PCBDDCSetUpLocalScatters should be called first! */
3726   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3727 
3728   /*
3729      Setup local correction and local part of coarse basis.
3730      Gives back the dense local part of the coarse matrix in column major ordering
3731   */
3732   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3733 
3734   /* Compute total number of coarse nodes and setup coarse solver */
3735   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3736 
3737   /* free */
3738   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3739   PetscFunctionReturn(0);
3740 }
3741 
3742 PetscErrorCode PCBDDCResetCustomization(PC pc)
3743 {
3744   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3745   PetscErrorCode ierr;
3746 
3747   PetscFunctionBegin;
3748   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3749   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3750   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3751   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3753   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3754   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3755   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3756   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3757   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3758   PetscFunctionReturn(0);
3759 }
3760 
3761 PetscErrorCode PCBDDCResetTopography(PC pc)
3762 {
3763   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3764   PetscInt       i;
3765   PetscErrorCode ierr;
3766 
3767   PetscFunctionBegin;
3768   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3769   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3770   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3771   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3772   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3773   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3774   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3775   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3776   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3777   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3778   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3779   for (i=0;i<pcbddc->n_local_subs;i++) {
3780     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3781   }
3782   pcbddc->n_local_subs = 0;
3783   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3784   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3785   pcbddc->graphanalyzed        = PETSC_FALSE;
3786   pcbddc->recompute_topography = PETSC_TRUE;
3787   pcbddc->corner_selected      = PETSC_FALSE;
3788   PetscFunctionReturn(0);
3789 }
3790 
3791 PetscErrorCode PCBDDCResetSolvers(PC pc)
3792 {
3793   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3794   PetscErrorCode ierr;
3795 
3796   PetscFunctionBegin;
3797   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3798   if (pcbddc->coarse_phi_B) {
3799     PetscScalar *array;
3800     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3801     ierr = PetscFree(array);CHKERRQ(ierr);
3802   }
3803   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3804   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3805   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3806   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3807   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3809   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3810   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3811   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3812   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3813   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3814   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3815   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3816   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3817   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3818   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3819   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3820   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3821   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3822   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3823   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3824   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3825   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3826   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3827   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3828   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3829   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3830   if (pcbddc->benign_zerodiag_subs) {
3831     PetscInt i;
3832     for (i=0;i<pcbddc->benign_n;i++) {
3833       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3834     }
3835     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3836   }
3837   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3838   PetscFunctionReturn(0);
3839 }
3840 
3841 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3842 {
3843   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3844   PC_IS          *pcis = (PC_IS*)pc->data;
3845   VecType        impVecType;
3846   PetscInt       n_constraints,n_R,old_size;
3847   PetscErrorCode ierr;
3848 
3849   PetscFunctionBegin;
3850   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3851   n_R = pcis->n - pcbddc->n_vertices;
3852   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3853   /* local work vectors (try to avoid unneeded work)*/
3854   /* R nodes */
3855   old_size = -1;
3856   if (pcbddc->vec1_R) {
3857     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3858   }
3859   if (n_R != old_size) {
3860     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3861     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3862     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3863     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3864     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3865     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3866   }
3867   /* local primal dofs */
3868   old_size = -1;
3869   if (pcbddc->vec1_P) {
3870     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3871   }
3872   if (pcbddc->local_primal_size != old_size) {
3873     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3874     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3875     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3876     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3877   }
3878   /* local explicit constraints */
3879   old_size = -1;
3880   if (pcbddc->vec1_C) {
3881     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3882   }
3883   if (n_constraints && n_constraints != old_size) {
3884     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3885     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3886     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3887     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3888   }
3889   PetscFunctionReturn(0);
3890 }
3891 
3892 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3893 {
3894   PetscErrorCode  ierr;
3895   /* pointers to pcis and pcbddc */
3896   PC_IS*          pcis = (PC_IS*)pc->data;
3897   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3898   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3899   /* submatrices of local problem */
3900   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3901   /* submatrices of local coarse problem */
3902   Mat             S_VV,S_CV,S_VC,S_CC;
3903   /* working matrices */
3904   Mat             C_CR;
3905   /* additional working stuff */
3906   PC              pc_R;
3907   Mat             F,Brhs = NULL;
3908   Vec             dummy_vec;
3909   PetscBool       isLU,isCHOL,need_benign_correction,sparserhs;
3910   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3911   PetscScalar     *work;
3912   PetscInt        *idx_V_B;
3913   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3914   PetscInt        i,n_R,n_D,n_B;
3915   PetscScalar     one=1.0,m_one=-1.0;
3916 
3917   PetscFunctionBegin;
3918   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");
3919   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3920 
3921   /* Set Non-overlapping dimensions */
3922   n_vertices = pcbddc->n_vertices;
3923   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3924   n_B = pcis->n_B;
3925   n_D = pcis->n - n_B;
3926   n_R = pcis->n - n_vertices;
3927 
3928   /* vertices in boundary numbering */
3929   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3930   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3931   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3932 
3933   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3934   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3935   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3936   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3937   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3938   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3939   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3940   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3941   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3942   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3943 
3944   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3945   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3946   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3947   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3948   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3949   lda_rhs = n_R;
3950   need_benign_correction = PETSC_FALSE;
3951   if (isLU || isCHOL) {
3952     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3953   } else if (sub_schurs && sub_schurs->reuse_solver) {
3954     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3955     MatFactorType      type;
3956 
3957     F = reuse_solver->F;
3958     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3959     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3960     if (type == MAT_FACTOR_LU) isLU = PETSC_TRUE;
3961     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3962     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3963   } else F = NULL;
3964 
3965   /* determine if we can use a sparse right-hand side */
3966   sparserhs = PETSC_FALSE;
3967   if (F) {
3968     MatSolverType solver;
3969 
3970     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3971     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3972   }
3973 
3974   /* allocate workspace */
3975   n = 0;
3976   if (n_constraints) {
3977     n += lda_rhs*n_constraints;
3978   }
3979   if (n_vertices) {
3980     n = PetscMax(2*lda_rhs*n_vertices,n);
3981     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3982   }
3983   if (!pcbddc->symmetric_primal) {
3984     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3985   }
3986   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3987 
3988   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3989   dummy_vec = NULL;
3990   if (need_benign_correction && lda_rhs != n_R && F) {
3991     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3992     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3993     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3994   }
3995 
3996   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3997   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3998 
3999   /* Precompute stuffs needed for preprocessing and application of BDDC*/
4000   if (n_constraints) {
4001     Mat         M3,C_B;
4002     IS          is_aux;
4003     PetscScalar *array,*array2;
4004 
4005     /* Extract constraints on R nodes: C_{CR}  */
4006     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4007     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4008     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4009 
4010     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4011     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4012     if (!sparserhs) {
4013       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4014       for (i=0;i<n_constraints;i++) {
4015         const PetscScalar *row_cmat_values;
4016         const PetscInt    *row_cmat_indices;
4017         PetscInt          size_of_constraint,j;
4018 
4019         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4020         for (j=0;j<size_of_constraint;j++) {
4021           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4022         }
4023         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4024       }
4025       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4026     } else {
4027       Mat tC_CR;
4028 
4029       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4030       if (lda_rhs != n_R) {
4031         PetscScalar *aa;
4032         PetscInt    r,*ii,*jj;
4033         PetscBool   done;
4034 
4035         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4036         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4037         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4038         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4039         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4040         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4041       } else {
4042         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4043         tC_CR = C_CR;
4044       }
4045       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4046       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4047     }
4048     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4049     if (F) {
4050       if (need_benign_correction) {
4051         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4052 
4053         /* rhs is already zero on interior dofs, no need to change the rhs */
4054         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4055       }
4056       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4057       if (need_benign_correction) {
4058         PetscScalar        *marr;
4059         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4060 
4061         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4062         if (lda_rhs != n_R) {
4063           for (i=0;i<n_constraints;i++) {
4064             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4065             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4066             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4067           }
4068         } else {
4069           for (i=0;i<n_constraints;i++) {
4070             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4071             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4072             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4073           }
4074         }
4075         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4076       }
4077     } else {
4078       PetscScalar *marr;
4079 
4080       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4081       for (i=0;i<n_constraints;i++) {
4082         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4083         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4084         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4085         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4086         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4087         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4088       }
4089       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4090     }
4091     if (sparserhs) {
4092       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4093     }
4094     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4095     if (!pcbddc->switch_static) {
4096       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4097       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4098       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4099       for (i=0;i<n_constraints;i++) {
4100         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4101         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4102         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4103         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4104         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4105         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4106       }
4107       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4108       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4109       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4110     } else {
4111       if (lda_rhs != n_R) {
4112         IS dummy;
4113 
4114         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4115         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4116         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4117       } else {
4118         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4119         pcbddc->local_auxmat2 = local_auxmat2_R;
4120       }
4121       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4122     }
4123     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4124     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4125     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4126     if (isCHOL) {
4127       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4128     } else {
4129       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4130     }
4131     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4132     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4133     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4134     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4135     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4136     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4137   }
4138 
4139   /* Get submatrices from subdomain matrix */
4140   if (n_vertices) {
4141 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4142     PetscBool oldpin;
4143 #endif
4144     PetscBool isaij;
4145     IS        is_aux;
4146 
4147     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4148       IS tis;
4149 
4150       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4151       ierr = ISSort(tis);CHKERRQ(ierr);
4152       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4153       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4154     } else {
4155       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4156     }
4157 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4158     oldpin = pcbddc->local_mat->boundtocpu;
4159 #endif
4160     ierr = MatBindToCPU(pcbddc->local_mat,PETSC_TRUE);CHKERRQ(ierr);
4161     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4162     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4163     ierr = PetscObjectBaseTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isaij);CHKERRQ(ierr);
4164     if (!isaij) { /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4165       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4166     }
4167     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4168 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4169     ierr = MatBindToCPU(pcbddc->local_mat,oldpin);CHKERRQ(ierr);
4170 #endif
4171     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4172   }
4173 
4174   /* Matrix of coarse basis functions (local) */
4175   if (pcbddc->coarse_phi_B) {
4176     PetscInt on_B,on_primal,on_D=n_D;
4177     if (pcbddc->coarse_phi_D) {
4178       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4179     }
4180     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4181     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4182       PetscScalar *marray;
4183 
4184       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4185       ierr = PetscFree(marray);CHKERRQ(ierr);
4186       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4187       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4188       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4189       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4190     }
4191   }
4192 
4193   if (!pcbddc->coarse_phi_B) {
4194     PetscScalar *marr;
4195 
4196     /* memory size */
4197     n = n_B*pcbddc->local_primal_size;
4198     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4199     if (!pcbddc->symmetric_primal) n *= 2;
4200     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4201     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4202     marr += n_B*pcbddc->local_primal_size;
4203     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4204       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4205       marr += n_D*pcbddc->local_primal_size;
4206     }
4207     if (!pcbddc->symmetric_primal) {
4208       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4209       marr += n_B*pcbddc->local_primal_size;
4210       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4211         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4212       }
4213     } else {
4214       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4215       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4216       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4217         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4218         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4219       }
4220     }
4221   }
4222 
4223   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4224   p0_lidx_I = NULL;
4225   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4226     const PetscInt *idxs;
4227 
4228     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4229     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4230     for (i=0;i<pcbddc->benign_n;i++) {
4231       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4232     }
4233     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4234   }
4235 
4236   /* vertices */
4237   if (n_vertices) {
4238     PetscBool restoreavr = PETSC_FALSE;
4239 
4240     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4241 
4242     if (n_R) {
4243       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4244       PetscBLASInt      B_N,B_one = 1;
4245       const PetscScalar *x;
4246       PetscScalar       *y;
4247 
4248       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4249       if (need_benign_correction) {
4250         ISLocalToGlobalMapping RtoN;
4251         IS                     is_p0;
4252         PetscInt               *idxs_p0,n;
4253 
4254         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4255         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4256         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4257         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);
4258         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4259         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4260         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4261         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4262       }
4263 
4264       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4265       if (!sparserhs || need_benign_correction) {
4266         if (lda_rhs == n_R) {
4267           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4268         } else {
4269           PetscScalar    *av,*array;
4270           const PetscInt *xadj,*adjncy;
4271           PetscInt       n;
4272           PetscBool      flg_row;
4273 
4274           array = work+lda_rhs*n_vertices;
4275           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4276           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4277           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4278           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4279           for (i=0;i<n;i++) {
4280             PetscInt j;
4281             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4282           }
4283           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4284           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4285           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4286         }
4287         if (need_benign_correction) {
4288           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4289           PetscScalar        *marr;
4290 
4291           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4292           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4293 
4294                  | 0 0  0 | (V)
4295              L = | 0 0 -1 | (P-p0)
4296                  | 0 0 -1 | (p0)
4297 
4298           */
4299           for (i=0;i<reuse_solver->benign_n;i++) {
4300             const PetscScalar *vals;
4301             const PetscInt    *idxs,*idxs_zero;
4302             PetscInt          n,j,nz;
4303 
4304             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4305             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4306             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4307             for (j=0;j<n;j++) {
4308               PetscScalar val = vals[j];
4309               PetscInt    k,col = idxs[j];
4310               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4311             }
4312             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4313             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4314           }
4315           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4316         }
4317         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4318         Brhs = A_RV;
4319       } else {
4320         Mat tA_RVT,A_RVT;
4321 
4322         if (!pcbddc->symmetric_primal) {
4323           /* A_RV already scaled by -1 */
4324           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4325         } else {
4326           restoreavr = PETSC_TRUE;
4327           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4328           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4329           A_RVT = A_VR;
4330         }
4331         if (lda_rhs != n_R) {
4332           PetscScalar *aa;
4333           PetscInt    r,*ii,*jj;
4334           PetscBool   done;
4335 
4336           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4337           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4338           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4339           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4340           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4341           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4342         } else {
4343           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4344           tA_RVT = A_RVT;
4345         }
4346         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4347         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4348         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4349       }
4350       if (F) {
4351         /* need to correct the rhs */
4352         if (need_benign_correction) {
4353           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4354           PetscScalar        *marr;
4355 
4356           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4357           if (lda_rhs != n_R) {
4358             for (i=0;i<n_vertices;i++) {
4359               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4360               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4361               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4362             }
4363           } else {
4364             for (i=0;i<n_vertices;i++) {
4365               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4366               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4367               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4368             }
4369           }
4370           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4371         }
4372         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4373         if (restoreavr) {
4374           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4375         }
4376         /* need to correct the solution */
4377         if (need_benign_correction) {
4378           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4379           PetscScalar        *marr;
4380 
4381           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4382           if (lda_rhs != n_R) {
4383             for (i=0;i<n_vertices;i++) {
4384               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4385               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4386               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4387             }
4388           } else {
4389             for (i=0;i<n_vertices;i++) {
4390               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4391               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4392               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4393             }
4394           }
4395           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4396         }
4397       } else {
4398         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4399         for (i=0;i<n_vertices;i++) {
4400           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4401           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4402           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4403           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4404           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4405           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4406         }
4407         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4408       }
4409       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4410       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4411       /* S_VV and S_CV */
4412       if (n_constraints) {
4413         Mat B;
4414 
4415         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4416         for (i=0;i<n_vertices;i++) {
4417           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4418           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4419           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4420           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4421           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4422           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4423         }
4424         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4425         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4426         ierr = MatDestroy(&B);CHKERRQ(ierr);
4427         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4428         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4429         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4430         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4431         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4432         ierr = MatDestroy(&B);CHKERRQ(ierr);
4433       }
4434       if (lda_rhs != n_R) {
4435         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4436         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4437         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4438       }
4439       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4440       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4441       if (need_benign_correction) {
4442         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4443         PetscScalar      *marr,*sums;
4444 
4445         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4446         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4447         for (i=0;i<reuse_solver->benign_n;i++) {
4448           const PetscScalar *vals;
4449           const PetscInt    *idxs,*idxs_zero;
4450           PetscInt          n,j,nz;
4451 
4452           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4453           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4454           for (j=0;j<n_vertices;j++) {
4455             PetscInt k;
4456             sums[j] = 0.;
4457             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4458           }
4459           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4460           for (j=0;j<n;j++) {
4461             PetscScalar val = vals[j];
4462             PetscInt k;
4463             for (k=0;k<n_vertices;k++) {
4464               marr[idxs[j]+k*n_vertices] += val*sums[k];
4465             }
4466           }
4467           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4468           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4469         }
4470         ierr = PetscFree(sums);CHKERRQ(ierr);
4471         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4472         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4473       }
4474       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4475       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4476       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4477       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4478       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4479       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4480       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4481       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4482       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4483     } else {
4484       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4485     }
4486     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4487 
4488     /* coarse basis functions */
4489     for (i=0;i<n_vertices;i++) {
4490       PetscScalar *y;
4491 
4492       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4493       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4494       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4495       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4496       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4497       y[n_B*i+idx_V_B[i]] = 1.0;
4498       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4499       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4500 
4501       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4502         PetscInt j;
4503 
4504         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4505         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4506         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4507         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4508         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4509         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4510         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4511       }
4512       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4513     }
4514     /* if n_R == 0 the object is not destroyed */
4515     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4516   }
4517   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4518 
4519   if (n_constraints) {
4520     Mat B;
4521 
4522     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4523     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4524     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4525     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4526     if (n_vertices) {
4527       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4528         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4529       } else {
4530         Mat S_VCt;
4531 
4532         if (lda_rhs != n_R) {
4533           ierr = MatDestroy(&B);CHKERRQ(ierr);
4534           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4535           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4536         }
4537         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4538         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4539         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4540       }
4541     }
4542     ierr = MatDestroy(&B);CHKERRQ(ierr);
4543     /* coarse basis functions */
4544     for (i=0;i<n_constraints;i++) {
4545       PetscScalar *y;
4546 
4547       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4548       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4549       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4550       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4551       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4552       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4553       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4554       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4555         PetscInt j;
4556 
4557         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4558         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4559         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4560         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4561         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4562         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4563         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4564       }
4565       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4566     }
4567   }
4568   if (n_constraints) {
4569     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4570   }
4571   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4572 
4573   /* coarse matrix entries relative to B_0 */
4574   if (pcbddc->benign_n) {
4575     Mat               B0_B,B0_BPHI;
4576     IS                is_dummy;
4577     const PetscScalar *data;
4578     PetscInt          j;
4579 
4580     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4581     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4582     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4583     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4584     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4585     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4586     for (j=0;j<pcbddc->benign_n;j++) {
4587       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4588       for (i=0;i<pcbddc->local_primal_size;i++) {
4589         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4590         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4591       }
4592     }
4593     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4594     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4595     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4596   }
4597 
4598   /* compute other basis functions for non-symmetric problems */
4599   if (!pcbddc->symmetric_primal) {
4600     Mat         B_V=NULL,B_C=NULL;
4601     PetscScalar *marray;
4602 
4603     if (n_constraints) {
4604       Mat S_CCT,C_CRT;
4605 
4606       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4607       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4608       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4609       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4610       if (n_vertices) {
4611         Mat S_VCT;
4612 
4613         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4614         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4615         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4616       }
4617       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4618     } else {
4619       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4620     }
4621     if (n_vertices && n_R) {
4622       PetscScalar    *av,*marray;
4623       const PetscInt *xadj,*adjncy;
4624       PetscInt       n;
4625       PetscBool      flg_row;
4626 
4627       /* B_V = B_V - A_VR^T */
4628       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4629       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4630       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4631       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4632       for (i=0;i<n;i++) {
4633         PetscInt j;
4634         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4635       }
4636       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4637       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4638       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4639     }
4640 
4641     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4642     if (n_vertices) {
4643       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4644       for (i=0;i<n_vertices;i++) {
4645         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4646         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4647         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4648         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4649         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4650         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4651       }
4652       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4653     }
4654     if (B_C) {
4655       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4656       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4657         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4658         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4659         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4660         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4661         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4662         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4663       }
4664       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4665     }
4666     /* coarse basis functions */
4667     for (i=0;i<pcbddc->local_primal_size;i++) {
4668       PetscScalar *y;
4669 
4670       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4671       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4672       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4673       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4674       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4675       if (i<n_vertices) {
4676         y[n_B*i+idx_V_B[i]] = 1.0;
4677       }
4678       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4679       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4680 
4681       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4682         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4683         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4684         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4685         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4686         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4687         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4688       }
4689       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4690     }
4691     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4692     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4693   }
4694 
4695   /* free memory */
4696   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4697   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4698   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4699   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4700   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4701   ierr = PetscFree(work);CHKERRQ(ierr);
4702   if (n_vertices) {
4703     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4704   }
4705   if (n_constraints) {
4706     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4707   }
4708   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4709 
4710   /* Checking coarse_sub_mat and coarse basis functios */
4711   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4712   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4713   if (pcbddc->dbg_flag) {
4714     Mat         coarse_sub_mat;
4715     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4716     Mat         coarse_phi_D,coarse_phi_B;
4717     Mat         coarse_psi_D,coarse_psi_B;
4718     Mat         A_II,A_BB,A_IB,A_BI;
4719     Mat         C_B,CPHI;
4720     IS          is_dummy;
4721     Vec         mones;
4722     MatType     checkmattype=MATSEQAIJ;
4723     PetscReal   real_value;
4724 
4725     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4726       Mat A;
4727       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4728       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4729       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4730       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4731       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4732       ierr = MatDestroy(&A);CHKERRQ(ierr);
4733     } else {
4734       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4735       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4736       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4737       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4738     }
4739     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4740     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4741     if (!pcbddc->symmetric_primal) {
4742       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4743       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4744     }
4745     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4746 
4747     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4748     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4749     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4750     if (!pcbddc->symmetric_primal) {
4751       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4752       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4753       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4754       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4755       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4756       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4757       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4758       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4759       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4760       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4761       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4762       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4763     } else {
4764       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4765       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4766       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4767       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4768       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4769       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4770       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4771       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4772     }
4773     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4774     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4775     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4776     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4777     if (pcbddc->benign_n) {
4778       Mat               B0_B,B0_BPHI;
4779       const PetscScalar *data2;
4780       PetscScalar       *data;
4781       PetscInt          j;
4782 
4783       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4784       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4785       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4786       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4787       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4788       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4789       for (j=0;j<pcbddc->benign_n;j++) {
4790         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4791         for (i=0;i<pcbddc->local_primal_size;i++) {
4792           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4793           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4794         }
4795       }
4796       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4797       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4798       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4799       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4800       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4801     }
4802 #if 0
4803   {
4804     PetscViewer viewer;
4805     char filename[256];
4806     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4807     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4808     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4809     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4810     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4811     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4812     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4813     if (pcbddc->coarse_phi_B) {
4814       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4815       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4816     }
4817     if (pcbddc->coarse_phi_D) {
4818       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4819       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4820     }
4821     if (pcbddc->coarse_psi_B) {
4822       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4823       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4824     }
4825     if (pcbddc->coarse_psi_D) {
4826       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4827       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4828     }
4829     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4830     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4831     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4832     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4833     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4834     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4835     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4836     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4837     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4838     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4839     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4840   }
4841 #endif
4842     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4843     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4844     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4845     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4846 
4847     /* check constraints */
4848     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4849     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4850     if (!pcbddc->benign_n) { /* TODO: add benign case */
4851       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4852     } else {
4853       PetscScalar *data;
4854       Mat         tmat;
4855       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4856       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4857       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4858       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4859       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4860     }
4861     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4862     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4863     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4864     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4865     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4866     if (!pcbddc->symmetric_primal) {
4867       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4868       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4869       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4870       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4871       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4872     }
4873     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4874     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4875     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4876     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4877     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4878     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4879     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4880     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4881     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4882     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4883     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4884     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4885     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4886     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4887     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4888     if (!pcbddc->symmetric_primal) {
4889       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4890       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4891     }
4892     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4893   }
4894   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4895   {
4896     PetscBool gpu;
4897 
4898     ierr = PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu);CHKERRQ(ierr);
4899     if (gpu) {
4900       if (pcbddc->local_auxmat1) {
4901         ierr = MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4902       }
4903       if (pcbddc->local_auxmat2) {
4904         ierr = MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4905       }
4906       if (pcbddc->coarse_phi_B) {
4907         ierr = MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4908       }
4909       if (pcbddc->coarse_phi_D) {
4910         ierr = MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4911       }
4912       if (pcbddc->coarse_psi_B) {
4913         ierr = MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4914       }
4915       if (pcbddc->coarse_psi_D) {
4916         ierr = MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4917       }
4918     }
4919   }
4920   /* get back data */
4921   *coarse_submat_vals_n = coarse_submat_vals;
4922   PetscFunctionReturn(0);
4923 }
4924 
4925 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4926 {
4927   Mat            *work_mat;
4928   IS             isrow_s,iscol_s;
4929   PetscBool      rsorted,csorted;
4930   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4931   PetscErrorCode ierr;
4932 
4933   PetscFunctionBegin;
4934   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4935   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4936   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4937   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4938 
4939   if (!rsorted) {
4940     const PetscInt *idxs;
4941     PetscInt *idxs_sorted,i;
4942 
4943     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4944     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4945     for (i=0;i<rsize;i++) {
4946       idxs_perm_r[i] = i;
4947     }
4948     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4949     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4950     for (i=0;i<rsize;i++) {
4951       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4952     }
4953     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4954     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4955   } else {
4956     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4957     isrow_s = isrow;
4958   }
4959 
4960   if (!csorted) {
4961     if (isrow == iscol) {
4962       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4963       iscol_s = isrow_s;
4964     } else {
4965       const PetscInt *idxs;
4966       PetscInt       *idxs_sorted,i;
4967 
4968       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4969       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4970       for (i=0;i<csize;i++) {
4971         idxs_perm_c[i] = i;
4972       }
4973       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4974       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4975       for (i=0;i<csize;i++) {
4976         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4977       }
4978       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4979       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4980     }
4981   } else {
4982     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4983     iscol_s = iscol;
4984   }
4985 
4986   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4987 
4988   if (!rsorted || !csorted) {
4989     Mat      new_mat;
4990     IS       is_perm_r,is_perm_c;
4991 
4992     if (!rsorted) {
4993       PetscInt *idxs_r,i;
4994       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4995       for (i=0;i<rsize;i++) {
4996         idxs_r[idxs_perm_r[i]] = i;
4997       }
4998       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4999       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
5000     } else {
5001       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
5002     }
5003     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
5004 
5005     if (!csorted) {
5006       if (isrow_s == iscol_s) {
5007         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
5008         is_perm_c = is_perm_r;
5009       } else {
5010         PetscInt *idxs_c,i;
5011         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5012         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
5013         for (i=0;i<csize;i++) {
5014           idxs_c[idxs_perm_c[i]] = i;
5015         }
5016         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
5017         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
5018       }
5019     } else {
5020       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
5021     }
5022     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
5023 
5024     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
5025     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
5026     work_mat[0] = new_mat;
5027     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
5028     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
5029   }
5030 
5031   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
5032   *B = work_mat[0];
5033   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
5034   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
5035   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5036   PetscFunctionReturn(0);
5037 }
5038 
5039 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5040 {
5041   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5042   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5043   Mat            new_mat,lA;
5044   IS             is_local,is_global;
5045   PetscInt       local_size;
5046   PetscBool      isseqaij;
5047   PetscErrorCode ierr;
5048 
5049   PetscFunctionBegin;
5050   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5051   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5052   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5053   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5054   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5055   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5056   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5057 
5058   if (pcbddc->dbg_flag) {
5059     Vec       x,x_change;
5060     PetscReal error;
5061 
5062     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5063     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5064     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5065     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5066     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5067     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5068     if (!pcbddc->change_interior) {
5069       const PetscScalar *x,*y,*v;
5070       PetscReal         lerror = 0.;
5071       PetscInt          i;
5072 
5073       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5074       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5075       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5076       for (i=0;i<local_size;i++)
5077         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5078           lerror = PetscAbsScalar(x[i]-y[i]);
5079       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5080       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5081       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5082       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5083       if (error > PETSC_SMALL) {
5084         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5085           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5086         } else {
5087           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5088         }
5089       }
5090     }
5091     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5092     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5093     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5094     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5095     if (error > PETSC_SMALL) {
5096       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5097         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5098       } else {
5099         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5100       }
5101     }
5102     ierr = VecDestroy(&x);CHKERRQ(ierr);
5103     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5104   }
5105 
5106   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5107   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5108 
5109   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5110   ierr = PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5111   if (isseqaij) {
5112     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5113     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5114     if (lA) {
5115       Mat work;
5116       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5117       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5118       ierr = MatDestroy(&work);CHKERRQ(ierr);
5119     }
5120   } else {
5121     Mat work_mat;
5122 
5123     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5124     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5125     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5126     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5127     if (lA) {
5128       Mat work;
5129       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5130       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5131       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5132       ierr = MatDestroy(&work);CHKERRQ(ierr);
5133     }
5134   }
5135   if (matis->A->symmetric_set) {
5136     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5137 #if !defined(PETSC_USE_COMPLEX)
5138     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5139 #endif
5140   }
5141   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5142   PetscFunctionReturn(0);
5143 }
5144 
5145 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5146 {
5147   PC_IS*          pcis = (PC_IS*)(pc->data);
5148   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5149   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5150   PetscInt        *idx_R_local=NULL;
5151   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5152   PetscInt        vbs,bs;
5153   PetscBT         bitmask=NULL;
5154   PetscErrorCode  ierr;
5155 
5156   PetscFunctionBegin;
5157   /*
5158     No need to setup local scatters if
5159       - primal space is unchanged
5160         AND
5161       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5162         AND
5163       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5164   */
5165   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5166     PetscFunctionReturn(0);
5167   }
5168   /* destroy old objects */
5169   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5170   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5171   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5172   /* Set Non-overlapping dimensions */
5173   n_B = pcis->n_B;
5174   n_D = pcis->n - n_B;
5175   n_vertices = pcbddc->n_vertices;
5176 
5177   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5178 
5179   /* create auxiliary bitmask and allocate workspace */
5180   if (!sub_schurs || !sub_schurs->reuse_solver) {
5181     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5182     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5183     for (i=0;i<n_vertices;i++) {
5184       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5185     }
5186 
5187     for (i=0, n_R=0; i<pcis->n; i++) {
5188       if (!PetscBTLookup(bitmask,i)) {
5189         idx_R_local[n_R++] = i;
5190       }
5191     }
5192   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5193     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5194 
5195     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5196     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5197   }
5198 
5199   /* Block code */
5200   vbs = 1;
5201   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5202   if (bs>1 && !(n_vertices%bs)) {
5203     PetscBool is_blocked = PETSC_TRUE;
5204     PetscInt  *vary;
5205     if (!sub_schurs || !sub_schurs->reuse_solver) {
5206       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5207       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5208       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5209       /* 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 */
5210       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5211       for (i=0; i<pcis->n/bs; i++) {
5212         if (vary[i]!=0 && vary[i]!=bs) {
5213           is_blocked = PETSC_FALSE;
5214           break;
5215         }
5216       }
5217       ierr = PetscFree(vary);CHKERRQ(ierr);
5218     } else {
5219       /* Verify directly the R set */
5220       for (i=0; i<n_R/bs; i++) {
5221         PetscInt j,node=idx_R_local[bs*i];
5222         for (j=1; j<bs; j++) {
5223           if (node != idx_R_local[bs*i+j]-j) {
5224             is_blocked = PETSC_FALSE;
5225             break;
5226           }
5227         }
5228       }
5229     }
5230     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5231       vbs = bs;
5232       for (i=0;i<n_R/vbs;i++) {
5233         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5234       }
5235     }
5236   }
5237   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5238   if (sub_schurs && sub_schurs->reuse_solver) {
5239     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5240 
5241     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5242     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5243     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5244     reuse_solver->is_R = pcbddc->is_R_local;
5245   } else {
5246     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5247   }
5248 
5249   /* print some info if requested */
5250   if (pcbddc->dbg_flag) {
5251     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5252     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5253     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5254     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5255     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5256     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);
5257     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5258   }
5259 
5260   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5261   if (!sub_schurs || !sub_schurs->reuse_solver) {
5262     IS       is_aux1,is_aux2;
5263     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5264 
5265     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5266     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5267     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5268     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5269     for (i=0; i<n_D; i++) {
5270       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5271     }
5272     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5273     for (i=0, j=0; i<n_R; i++) {
5274       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5275         aux_array1[j++] = i;
5276       }
5277     }
5278     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5279     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5280     for (i=0, j=0; i<n_B; i++) {
5281       if (!PetscBTLookup(bitmask,is_indices[i])) {
5282         aux_array2[j++] = i;
5283       }
5284     }
5285     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5286     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5287     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5288     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5289     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5290 
5291     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5292       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5293       for (i=0, j=0; i<n_R; i++) {
5294         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5295           aux_array1[j++] = i;
5296         }
5297       }
5298       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5299       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5300       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5301     }
5302     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5303     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5304   } else {
5305     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5306     IS                 tis;
5307     PetscInt           schur_size;
5308 
5309     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5310     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5311     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5312     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5313     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5314       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5315       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5316       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5317     }
5318   }
5319   PetscFunctionReturn(0);
5320 }
5321 
5322 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5323 {
5324   MatNullSpace   NullSpace;
5325   Mat            dmat;
5326   const Vec      *nullvecs;
5327   Vec            v,v2,*nullvecs2;
5328   VecScatter     sct = NULL;
5329   PetscContainer c;
5330   PetscScalar    *ddata;
5331   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5332   PetscBool      nnsp_has_cnst;
5333   PetscErrorCode ierr;
5334 
5335   PetscFunctionBegin;
5336   if (!is && !B) { /* MATIS */
5337     Mat_IS* matis = (Mat_IS*)A->data;
5338 
5339     if (!B) {
5340       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5341     }
5342     sct  = matis->cctx;
5343     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5344   } else {
5345     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5346     if (!NullSpace) {
5347       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5348     }
5349     if (NullSpace) PetscFunctionReturn(0);
5350   }
5351   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5352   if (!NullSpace) {
5353     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5354   }
5355   if (!NullSpace) PetscFunctionReturn(0);
5356 
5357   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5358   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5359   if (!sct) {
5360     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5361   }
5362   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5363   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5364   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5365   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5366   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5367   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5368   ierr = PetscMalloc1(n*bsiz,&ddata);CHKERRQ(ierr);
5369   for (k=0;k<nnsp_size;k++) {
5370     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]);CHKERRQ(ierr);
5371     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5372     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5373   }
5374   if (nnsp_has_cnst) {
5375     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5376     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5377   }
5378   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5379   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5380 
5381   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat);CHKERRQ(ierr);
5382   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)B),&c);CHKERRQ(ierr);
5383   ierr = PetscContainerSetPointer(c,ddata);CHKERRQ(ierr);
5384   ierr = PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault);CHKERRQ(ierr);
5385   ierr = PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c);CHKERRQ(ierr);
5386   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
5387   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5388   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5389 
5390   for (k=0;k<bsiz;k++) {
5391     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5392   }
5393   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5394   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5395   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5396   ierr = VecDestroy(&v);CHKERRQ(ierr);
5397   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5398   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5399   PetscFunctionReturn(0);
5400 }
5401 
5402 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5403 {
5404   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5405   PC_IS          *pcis = (PC_IS*)pc->data;
5406   PC             pc_temp;
5407   Mat            A_RR;
5408   MatNullSpace   nnsp;
5409   MatReuse       reuse;
5410   PetscScalar    m_one = -1.0;
5411   PetscReal      value;
5412   PetscInt       n_D,n_R;
5413   PetscBool      issbaij,opts;
5414   PetscErrorCode ierr;
5415   void           (*f)(void) = 0;
5416   char           dir_prefix[256],neu_prefix[256],str_level[16];
5417   size_t         len;
5418 
5419   PetscFunctionBegin;
5420   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5421   /* approximate solver, propagate NearNullSpace if needed */
5422   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5423     MatNullSpace gnnsp1,gnnsp2;
5424     PetscBool    lhas,ghas;
5425 
5426     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5427     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5428     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5429     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5430     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5431     if (!ghas && (gnnsp1 || gnnsp2)) {
5432       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5433     }
5434   }
5435 
5436   /* compute prefixes */
5437   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5438   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5439   if (!pcbddc->current_level) {
5440     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5441     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5442     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5443     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5444   } else {
5445     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5446     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5447     len -= 15; /* remove "pc_bddc_coarse_" */
5448     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5449     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5450     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5451     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5452     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5453     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5454     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5455     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5456     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5457   }
5458 
5459   /* DIRICHLET PROBLEM */
5460   if (dirichlet) {
5461     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5462     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5463       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5464       if (pcbddc->dbg_flag) {
5465         Mat    A_IIn;
5466 
5467         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5468         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5469         pcis->A_II = A_IIn;
5470       }
5471     }
5472     if (pcbddc->local_mat->symmetric_set) {
5473       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5474     }
5475     /* Matrix for Dirichlet problem is pcis->A_II */
5476     n_D  = pcis->n - pcis->n_B;
5477     opts = PETSC_FALSE;
5478     if (!pcbddc->ksp_D) { /* create object if not yet build */
5479       opts = PETSC_TRUE;
5480       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5481       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5482       /* default */
5483       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5484       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5485       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5486       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5487       if (issbaij) {
5488         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5489       } else {
5490         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5491       }
5492       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5493     }
5494     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5495     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5496     /* Allow user's customization */
5497     if (opts) {
5498       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5499     }
5500     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5501     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5502       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5503     }
5504     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5505     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5506     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5507     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5508       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5509       const PetscInt *idxs;
5510       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5511 
5512       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5513       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5514       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5515       for (i=0;i<nl;i++) {
5516         for (d=0;d<cdim;d++) {
5517           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5518         }
5519       }
5520       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5521       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5522       ierr = PetscFree(scoords);CHKERRQ(ierr);
5523     }
5524     if (sub_schurs && sub_schurs->reuse_solver) {
5525       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5526 
5527       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5528     }
5529 
5530     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5531     if (!n_D) {
5532       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5533       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5534     }
5535     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5536     /* set ksp_D into pcis data */
5537     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5538     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5539     pcis->ksp_D = pcbddc->ksp_D;
5540   }
5541 
5542   /* NEUMANN PROBLEM */
5543   A_RR = 0;
5544   if (neumann) {
5545     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5546     PetscInt        ibs,mbs;
5547     PetscBool       issbaij, reuse_neumann_solver;
5548     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5549 
5550     reuse_neumann_solver = PETSC_FALSE;
5551     if (sub_schurs && sub_schurs->reuse_solver) {
5552       IS iP;
5553 
5554       reuse_neumann_solver = PETSC_TRUE;
5555       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5556       if (iP) reuse_neumann_solver = PETSC_FALSE;
5557     }
5558     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5559     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5560     if (pcbddc->ksp_R) { /* already created ksp */
5561       PetscInt nn_R;
5562       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5563       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5564       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5565       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5566         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5567         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5568         reuse = MAT_INITIAL_MATRIX;
5569       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5570         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5571           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5572           reuse = MAT_INITIAL_MATRIX;
5573         } else { /* safe to reuse the matrix */
5574           reuse = MAT_REUSE_MATRIX;
5575         }
5576       }
5577       /* last check */
5578       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5579         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5580         reuse = MAT_INITIAL_MATRIX;
5581       }
5582     } else { /* first time, so we need to create the matrix */
5583       reuse = MAT_INITIAL_MATRIX;
5584     }
5585     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5586        TODO: Get Rid of these conversions */
5587     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5588     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5589     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5590     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5591       if (matis->A == pcbddc->local_mat) {
5592         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5593         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5594       } else {
5595         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5596       }
5597     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5598       if (matis->A == pcbddc->local_mat) {
5599         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5600         ierr = MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5601       } else {
5602         ierr = MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5603       }
5604     }
5605     /* extract A_RR */
5606     if (reuse_neumann_solver) {
5607       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5608 
5609       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5610         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5611         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5612           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5613         } else {
5614           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5615         }
5616       } else {
5617         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5618         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5619         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5620       }
5621     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5622       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5623     }
5624     if (pcbddc->local_mat->symmetric_set) {
5625       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5626     }
5627     opts = PETSC_FALSE;
5628     if (!pcbddc->ksp_R) { /* create object if not present */
5629       opts = PETSC_TRUE;
5630       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5631       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5632       /* default */
5633       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5634       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5635       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5636       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5637       if (issbaij) {
5638         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5639       } else {
5640         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5641       }
5642       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5643     }
5644     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5645     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5646     if (opts) { /* Allow user's customization once */
5647       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5648     }
5649     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5650     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5651       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5652     }
5653     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5654     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5655     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5656     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5657       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5658       const PetscInt *idxs;
5659       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5660 
5661       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5662       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5663       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5664       for (i=0;i<nl;i++) {
5665         for (d=0;d<cdim;d++) {
5666           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5667         }
5668       }
5669       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5670       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5671       ierr = PetscFree(scoords);CHKERRQ(ierr);
5672     }
5673 
5674     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5675     if (!n_R) {
5676       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5677       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5678     }
5679     /* Reuse solver if it is present */
5680     if (reuse_neumann_solver) {
5681       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5682 
5683       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5684     }
5685     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5686   }
5687 
5688   if (pcbddc->dbg_flag) {
5689     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5690     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5691     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5692   }
5693   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5694 
5695   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5696   if (pcbddc->NullSpace_corr[0]) {
5697     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5698   }
5699   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5700     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5701   }
5702   if (neumann && pcbddc->NullSpace_corr[2]) {
5703     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5704   }
5705   /* check Dirichlet and Neumann solvers */
5706   if (pcbddc->dbg_flag) {
5707     if (dirichlet) { /* Dirichlet */
5708       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5709       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5710       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5711       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5712       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5713       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5714       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);
5715       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5716     }
5717     if (neumann) { /* Neumann */
5718       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5719       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5720       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5721       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5722       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5723       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5724       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);
5725       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5726     }
5727   }
5728   /* free Neumann problem's matrix */
5729   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5730   PetscFunctionReturn(0);
5731 }
5732 
5733 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5734 {
5735   PetscErrorCode  ierr;
5736   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5737   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5738   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5739 
5740   PetscFunctionBegin;
5741   if (!reuse_solver) {
5742     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5743   }
5744   if (!pcbddc->switch_static) {
5745     if (applytranspose && pcbddc->local_auxmat1) {
5746       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5747       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5748     }
5749     if (!reuse_solver) {
5750       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5751       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5752     } else {
5753       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5754 
5755       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5756       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5757     }
5758   } else {
5759     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5760     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5761     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5762     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5763     if (applytranspose && pcbddc->local_auxmat1) {
5764       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5765       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5766       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5767       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5768     }
5769   }
5770   if (!reuse_solver || pcbddc->switch_static) {
5771     if (applytranspose) {
5772       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5773     } else {
5774       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5775     }
5776     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5777   } else {
5778     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5779 
5780     if (applytranspose) {
5781       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5782     } else {
5783       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5784     }
5785   }
5786   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5787   if (!pcbddc->switch_static) {
5788     if (!reuse_solver) {
5789       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5790       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5791     } else {
5792       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5793 
5794       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5795       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5796     }
5797     if (!applytranspose && pcbddc->local_auxmat1) {
5798       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5799       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5800     }
5801   } else {
5802     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5803     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5804     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5805     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5806     if (!applytranspose && pcbddc->local_auxmat1) {
5807       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5808       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5809     }
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     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5813     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5814   }
5815   PetscFunctionReturn(0);
5816 }
5817 
5818 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5819 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5820 {
5821   PetscErrorCode ierr;
5822   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5823   PC_IS*            pcis = (PC_IS*)  (pc->data);
5824   const PetscScalar zero = 0.0;
5825 
5826   PetscFunctionBegin;
5827   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5828   if (!pcbddc->benign_apply_coarse_only) {
5829     if (applytranspose) {
5830       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5831       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5832     } else {
5833       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5834       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5835     }
5836   } else {
5837     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5838   }
5839 
5840   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5841   if (pcbddc->benign_n) {
5842     PetscScalar *array;
5843     PetscInt    j;
5844 
5845     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5846     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5847     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5848   }
5849 
5850   /* start communications from local primal nodes to rhs of coarse solver */
5851   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5852   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5853   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5854 
5855   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5856   if (pcbddc->coarse_ksp) {
5857     Mat          coarse_mat;
5858     Vec          rhs,sol;
5859     MatNullSpace nullsp;
5860     PetscBool    isbddc = PETSC_FALSE;
5861 
5862     if (pcbddc->benign_have_null) {
5863       PC        coarse_pc;
5864 
5865       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5866       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5867       /* we need to propagate to coarser levels the need for a possible benign correction */
5868       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5869         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5870         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5871         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5872       }
5873     }
5874     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5875     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5876     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5877     if (applytranspose) {
5878       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5879       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5880       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5881       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5882       if (nullsp) {
5883         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5884       }
5885     } else {
5886       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5887       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5888         PC        coarse_pc;
5889 
5890         if (nullsp) {
5891           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5892         }
5893         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5894         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5895         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5896         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5897       } else {
5898         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5899         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5900         if (nullsp) {
5901           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5902         }
5903       }
5904     }
5905     /* we don't need the benign correction at coarser levels anymore */
5906     if (pcbddc->benign_have_null && isbddc) {
5907       PC        coarse_pc;
5908       PC_BDDC*  coarsepcbddc;
5909 
5910       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5911       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5912       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5913       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5914     }
5915   }
5916 
5917   /* Local solution on R nodes */
5918   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5919     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5920   }
5921   /* communications from coarse sol to local primal nodes */
5922   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5923   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5924 
5925   /* Sum contributions from the two levels */
5926   if (!pcbddc->benign_apply_coarse_only) {
5927     if (applytranspose) {
5928       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5929       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5930     } else {
5931       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5932       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5933     }
5934     /* store p0 */
5935     if (pcbddc->benign_n) {
5936       PetscScalar *array;
5937       PetscInt    j;
5938 
5939       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5940       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5941       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5942     }
5943   } else { /* expand the coarse solution */
5944     if (applytranspose) {
5945       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5946     } else {
5947       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5948     }
5949   }
5950   PetscFunctionReturn(0);
5951 }
5952 
5953 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5954 {
5955   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5956   Vec               from,to;
5957   const PetscScalar *array;
5958   PetscErrorCode    ierr;
5959 
5960   PetscFunctionBegin;
5961   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5962     from = pcbddc->coarse_vec;
5963     to = pcbddc->vec1_P;
5964     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5965       Vec tvec;
5966 
5967       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5968       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5969       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5970       ierr = VecGetArrayRead(tvec,&array);CHKERRQ(ierr);
5971       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5972       ierr = VecRestoreArrayRead(tvec,&array);CHKERRQ(ierr);
5973     }
5974   } else { /* from local to global -> put data in coarse right hand side */
5975     from = pcbddc->vec1_P;
5976     to = pcbddc->coarse_vec;
5977   }
5978   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5979   PetscFunctionReturn(0);
5980 }
5981 
5982 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5983 {
5984   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5985   Vec               from,to;
5986   const PetscScalar *array;
5987   PetscErrorCode    ierr;
5988 
5989   PetscFunctionBegin;
5990   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5991     from = pcbddc->coarse_vec;
5992     to = pcbddc->vec1_P;
5993   } else { /* from local to global -> put data in coarse right hand side */
5994     from = pcbddc->vec1_P;
5995     to = pcbddc->coarse_vec;
5996   }
5997   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5998   if (smode == SCATTER_FORWARD) {
5999     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
6000       Vec tvec;
6001 
6002       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6003       ierr = VecGetArrayRead(to,&array);CHKERRQ(ierr);
6004       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
6005       ierr = VecRestoreArrayRead(to,&array);CHKERRQ(ierr);
6006     }
6007   } else {
6008     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6009      ierr = VecResetArray(from);CHKERRQ(ierr);
6010     }
6011   }
6012   PetscFunctionReturn(0);
6013 }
6014 
6015 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6016 {
6017   PetscErrorCode    ierr;
6018   PC_IS*            pcis = (PC_IS*)(pc->data);
6019   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6020   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6021   /* one and zero */
6022   PetscScalar       one=1.0,zero=0.0;
6023   /* space to store constraints and their local indices */
6024   PetscScalar       *constraints_data;
6025   PetscInt          *constraints_idxs,*constraints_idxs_B;
6026   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6027   PetscInt          *constraints_n;
6028   /* iterators */
6029   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6030   /* BLAS integers */
6031   PetscBLASInt      lwork,lierr;
6032   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6033   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6034   /* reuse */
6035   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6036   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6037   /* change of basis */
6038   PetscBool         qr_needed;
6039   PetscBT           change_basis,qr_needed_idx;
6040   /* auxiliary stuff */
6041   PetscInt          *nnz,*is_indices;
6042   PetscInt          ncc;
6043   /* some quantities */
6044   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6045   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6046   PetscReal         tol; /* tolerance for retaining eigenmodes */
6047 
6048   PetscFunctionBegin;
6049   tol  = PetscSqrtReal(PETSC_SMALL);
6050   /* Destroy Mat objects computed previously */
6051   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6052   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6053   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6054   /* save info on constraints from previous setup (if any) */
6055   olocal_primal_size = pcbddc->local_primal_size;
6056   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6057   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6058   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6059   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6060   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6061   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6062 
6063   if (!pcbddc->adaptive_selection) {
6064     IS           ISForVertices,*ISForFaces,*ISForEdges;
6065     MatNullSpace nearnullsp;
6066     const Vec    *nearnullvecs;
6067     Vec          *localnearnullsp;
6068     PetscScalar  *array;
6069     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6070     PetscBool    nnsp_has_cnst;
6071     /* LAPACK working arrays for SVD or POD */
6072     PetscBool    skip_lapack,boolforchange;
6073     PetscScalar  *work;
6074     PetscReal    *singular_vals;
6075 #if defined(PETSC_USE_COMPLEX)
6076     PetscReal    *rwork;
6077 #endif
6078     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6079     PetscBLASInt dummy_int=1;
6080     PetscScalar  dummy_scalar=1.;
6081     PetscBool    use_pod = PETSC_FALSE;
6082 
6083     /* MKL SVD with same input gives different results on different processes! */
6084 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL)
6085     use_pod = PETSC_TRUE;
6086 #endif
6087     /* Get index sets for faces, edges and vertices from graph */
6088     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6089     /* print some info */
6090     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6091       PetscInt nv;
6092 
6093       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6094       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6095       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6096       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6097       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6098       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6099       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6100       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6101       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6102     }
6103 
6104     /* free unneeded index sets */
6105     if (!pcbddc->use_vertices) {
6106       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6107     }
6108     if (!pcbddc->use_edges) {
6109       for (i=0;i<n_ISForEdges;i++) {
6110         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6111       }
6112       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6113       n_ISForEdges = 0;
6114     }
6115     if (!pcbddc->use_faces) {
6116       for (i=0;i<n_ISForFaces;i++) {
6117         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6118       }
6119       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6120       n_ISForFaces = 0;
6121     }
6122 
6123     /* check if near null space is attached to global mat */
6124     if (pcbddc->use_nnsp) {
6125       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6126     } else nearnullsp = NULL;
6127 
6128     if (nearnullsp) {
6129       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6130       /* remove any stored info */
6131       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6132       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6133       /* store information for BDDC solver reuse */
6134       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6135       pcbddc->onearnullspace = nearnullsp;
6136       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6137       for (i=0;i<nnsp_size;i++) {
6138         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6139       }
6140     } else { /* if near null space is not provided BDDC uses constants by default */
6141       nnsp_size = 0;
6142       nnsp_has_cnst = PETSC_TRUE;
6143     }
6144     /* get max number of constraints on a single cc */
6145     max_constraints = nnsp_size;
6146     if (nnsp_has_cnst) max_constraints++;
6147 
6148     /*
6149          Evaluate maximum storage size needed by the procedure
6150          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6151          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6152          There can be multiple constraints per connected component
6153                                                                                                                                                            */
6154     n_vertices = 0;
6155     if (ISForVertices) {
6156       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6157     }
6158     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6159     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6160 
6161     total_counts = n_ISForFaces+n_ISForEdges;
6162     total_counts *= max_constraints;
6163     total_counts += n_vertices;
6164     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6165 
6166     total_counts = 0;
6167     max_size_of_constraint = 0;
6168     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6169       IS used_is;
6170       if (i<n_ISForEdges) {
6171         used_is = ISForEdges[i];
6172       } else {
6173         used_is = ISForFaces[i-n_ISForEdges];
6174       }
6175       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6176       total_counts += j;
6177       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6178     }
6179     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);
6180 
6181     /* get local part of global near null space vectors */
6182     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6183     for (k=0;k<nnsp_size;k++) {
6184       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6185       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6186       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6187     }
6188 
6189     /* whether or not to skip lapack calls */
6190     skip_lapack = PETSC_TRUE;
6191     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6192 
6193     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6194     if (!skip_lapack) {
6195       PetscScalar temp_work;
6196 
6197       if (use_pod) {
6198         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6199         ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6200         ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6201         ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6202 #if defined(PETSC_USE_COMPLEX)
6203         ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6204 #endif
6205         /* now we evaluate the optimal workspace using query with lwork=-1 */
6206         ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6207         ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6208         lwork = -1;
6209         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6210 #if !defined(PETSC_USE_COMPLEX)
6211         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6212 #else
6213         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6214 #endif
6215         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6216         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6217       } else {
6218 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6219         /* SVD */
6220         PetscInt max_n,min_n;
6221         max_n = max_size_of_constraint;
6222         min_n = max_constraints;
6223         if (max_size_of_constraint < max_constraints) {
6224           min_n = max_size_of_constraint;
6225           max_n = max_constraints;
6226         }
6227         ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6228 #if defined(PETSC_USE_COMPLEX)
6229         ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6230 #endif
6231         /* now we evaluate the optimal workspace using query with lwork=-1 */
6232         lwork = -1;
6233         ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6234         ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6235         ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6236         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6237 #if !defined(PETSC_USE_COMPLEX)
6238         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));
6239 #else
6240         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));
6241 #endif
6242         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6243         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6244 #else
6245         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6246 #endif /* on missing GESVD */
6247       }
6248       /* Allocate optimal workspace */
6249       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6250       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6251     }
6252     /* Now we can loop on constraining sets */
6253     total_counts = 0;
6254     constraints_idxs_ptr[0] = 0;
6255     constraints_data_ptr[0] = 0;
6256     /* vertices */
6257     if (n_vertices) {
6258       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6259       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6260       for (i=0;i<n_vertices;i++) {
6261         constraints_n[total_counts] = 1;
6262         constraints_data[total_counts] = 1.0;
6263         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6264         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6265         total_counts++;
6266       }
6267       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6268       n_vertices = total_counts;
6269     }
6270 
6271     /* edges and faces */
6272     total_counts_cc = total_counts;
6273     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6274       IS        used_is;
6275       PetscBool idxs_copied = PETSC_FALSE;
6276 
6277       if (ncc<n_ISForEdges) {
6278         used_is = ISForEdges[ncc];
6279         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6280       } else {
6281         used_is = ISForFaces[ncc-n_ISForEdges];
6282         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6283       }
6284       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6285 
6286       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6287       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6288       /* change of basis should not be performed on local periodic nodes */
6289       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6290       if (nnsp_has_cnst) {
6291         PetscScalar quad_value;
6292 
6293         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6294         idxs_copied = PETSC_TRUE;
6295 
6296         if (!pcbddc->use_nnsp_true) {
6297           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6298         } else {
6299           quad_value = 1.0;
6300         }
6301         for (j=0;j<size_of_constraint;j++) {
6302           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6303         }
6304         temp_constraints++;
6305         total_counts++;
6306       }
6307       for (k=0;k<nnsp_size;k++) {
6308         PetscReal real_value;
6309         PetscScalar *ptr_to_data;
6310 
6311         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6312         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6313         for (j=0;j<size_of_constraint;j++) {
6314           ptr_to_data[j] = array[is_indices[j]];
6315         }
6316         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6317         /* check if array is null on the connected component */
6318         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6319         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6320         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6321           temp_constraints++;
6322           total_counts++;
6323           if (!idxs_copied) {
6324             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6325             idxs_copied = PETSC_TRUE;
6326           }
6327         }
6328       }
6329       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6330       valid_constraints = temp_constraints;
6331       if (!pcbddc->use_nnsp_true && temp_constraints) {
6332         if (temp_constraints == 1) { /* just normalize the constraint */
6333           PetscScalar norm,*ptr_to_data;
6334 
6335           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6336           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6337           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6338           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6339           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6340         } else { /* perform SVD */
6341           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6342 
6343           if (use_pod) {
6344             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6345                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6346                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6347                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6348                   from that computed using LAPACKgesvd
6349                -> This is due to a different computation of eigenvectors in LAPACKheev
6350                -> The quality of the POD-computed basis will be the same */
6351             ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6352             /* Store upper triangular part of correlation matrix */
6353             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6354             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6355             for (j=0;j<temp_constraints;j++) {
6356               for (k=0;k<j+1;k++) {
6357                 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));
6358               }
6359             }
6360             /* compute eigenvalues and eigenvectors of correlation matrix */
6361             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6362             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6363 #if !defined(PETSC_USE_COMPLEX)
6364             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6365 #else
6366             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6367 #endif
6368             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6369             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6370             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6371             j = 0;
6372             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6373             total_counts = total_counts-j;
6374             valid_constraints = temp_constraints-j;
6375             /* scale and copy POD basis into used quadrature memory */
6376             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6377             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6378             ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6379             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6380             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6381             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6382             if (j<temp_constraints) {
6383               PetscInt ii;
6384               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6385               ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6386               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));
6387               ierr = PetscFPTrapPop();CHKERRQ(ierr);
6388               for (k=0;k<temp_constraints-j;k++) {
6389                 for (ii=0;ii<size_of_constraint;ii++) {
6390                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6391                 }
6392               }
6393             }
6394           } else {
6395 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6396             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6397             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6398             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6399             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6400 #if !defined(PETSC_USE_COMPLEX)
6401             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));
6402 #else
6403             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));
6404 #endif
6405             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6406             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6407             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6408             k = temp_constraints;
6409             if (k > size_of_constraint) k = size_of_constraint;
6410             j = 0;
6411             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6412             valid_constraints = k-j;
6413             total_counts = total_counts-temp_constraints+valid_constraints;
6414 #else
6415             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6416 #endif /* on missing GESVD */
6417           }
6418         }
6419       }
6420       /* update pointers information */
6421       if (valid_constraints) {
6422         constraints_n[total_counts_cc] = valid_constraints;
6423         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6424         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6425         /* set change_of_basis flag */
6426         if (boolforchange) {
6427           PetscBTSet(change_basis,total_counts_cc);
6428         }
6429         total_counts_cc++;
6430       }
6431     }
6432     /* free workspace */
6433     if (!skip_lapack) {
6434       ierr = PetscFree(work);CHKERRQ(ierr);
6435 #if defined(PETSC_USE_COMPLEX)
6436       ierr = PetscFree(rwork);CHKERRQ(ierr);
6437 #endif
6438       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6439       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6440       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6441     }
6442     for (k=0;k<nnsp_size;k++) {
6443       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6444     }
6445     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6446     /* free index sets of faces, edges and vertices */
6447     for (i=0;i<n_ISForFaces;i++) {
6448       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6449     }
6450     if (n_ISForFaces) {
6451       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6452     }
6453     for (i=0;i<n_ISForEdges;i++) {
6454       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6455     }
6456     if (n_ISForEdges) {
6457       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6458     }
6459     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6460   } else {
6461     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6462 
6463     total_counts = 0;
6464     n_vertices = 0;
6465     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6466       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6467     }
6468     max_constraints = 0;
6469     total_counts_cc = 0;
6470     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6471       total_counts += pcbddc->adaptive_constraints_n[i];
6472       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6473       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6474     }
6475     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6476     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6477     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6478     constraints_data = pcbddc->adaptive_constraints_data;
6479     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6480     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6481     total_counts_cc = 0;
6482     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6483       if (pcbddc->adaptive_constraints_n[i]) {
6484         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6485       }
6486     }
6487 
6488     max_size_of_constraint = 0;
6489     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]);
6490     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6491     /* Change of basis */
6492     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6493     if (pcbddc->use_change_of_basis) {
6494       for (i=0;i<sub_schurs->n_subs;i++) {
6495         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6496           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6497         }
6498       }
6499     }
6500   }
6501   pcbddc->local_primal_size = total_counts;
6502   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6503 
6504   /* map constraints_idxs in boundary numbering */
6505   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6506   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);
6507 
6508   /* Create constraint matrix */
6509   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6510   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6511   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6512 
6513   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6514   /* determine if a QR strategy is needed for change of basis */
6515   qr_needed = pcbddc->use_qr_single;
6516   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6517   total_primal_vertices=0;
6518   pcbddc->local_primal_size_cc = 0;
6519   for (i=0;i<total_counts_cc;i++) {
6520     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6521     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6522       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6523       pcbddc->local_primal_size_cc += 1;
6524     } else if (PetscBTLookup(change_basis,i)) {
6525       for (k=0;k<constraints_n[i];k++) {
6526         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6527       }
6528       pcbddc->local_primal_size_cc += constraints_n[i];
6529       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6530         PetscBTSet(qr_needed_idx,i);
6531         qr_needed = PETSC_TRUE;
6532       }
6533     } else {
6534       pcbddc->local_primal_size_cc += 1;
6535     }
6536   }
6537   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6538   pcbddc->n_vertices = total_primal_vertices;
6539   /* permute indices in order to have a sorted set of vertices */
6540   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6541   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);
6542   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6543   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6544 
6545   /* nonzero structure of constraint matrix */
6546   /* and get reference dof for local constraints */
6547   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6548   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6549 
6550   j = total_primal_vertices;
6551   total_counts = total_primal_vertices;
6552   cum = total_primal_vertices;
6553   for (i=n_vertices;i<total_counts_cc;i++) {
6554     if (!PetscBTLookup(change_basis,i)) {
6555       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6556       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6557       cum++;
6558       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6559       for (k=0;k<constraints_n[i];k++) {
6560         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6561         nnz[j+k] = size_of_constraint;
6562       }
6563       j += constraints_n[i];
6564     }
6565   }
6566   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6567   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6568   ierr = PetscFree(nnz);CHKERRQ(ierr);
6569 
6570   /* set values in constraint matrix */
6571   for (i=0;i<total_primal_vertices;i++) {
6572     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6573   }
6574   total_counts = total_primal_vertices;
6575   for (i=n_vertices;i<total_counts_cc;i++) {
6576     if (!PetscBTLookup(change_basis,i)) {
6577       PetscInt *cols;
6578 
6579       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6580       cols = constraints_idxs+constraints_idxs_ptr[i];
6581       for (k=0;k<constraints_n[i];k++) {
6582         PetscInt    row = total_counts+k;
6583         PetscScalar *vals;
6584 
6585         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6586         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6587       }
6588       total_counts += constraints_n[i];
6589     }
6590   }
6591   /* assembling */
6592   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6593   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6594   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6595 
6596   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6597   if (pcbddc->use_change_of_basis) {
6598     /* dual and primal dofs on a single cc */
6599     PetscInt     dual_dofs,primal_dofs;
6600     /* working stuff for GEQRF */
6601     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6602     PetscBLASInt lqr_work;
6603     /* working stuff for UNGQR */
6604     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6605     PetscBLASInt lgqr_work;
6606     /* working stuff for TRTRS */
6607     PetscScalar  *trs_rhs = NULL;
6608     PetscBLASInt Blas_NRHS;
6609     /* pointers for values insertion into change of basis matrix */
6610     PetscInt     *start_rows,*start_cols;
6611     PetscScalar  *start_vals;
6612     /* working stuff for values insertion */
6613     PetscBT      is_primal;
6614     PetscInt     *aux_primal_numbering_B;
6615     /* matrix sizes */
6616     PetscInt     global_size,local_size;
6617     /* temporary change of basis */
6618     Mat          localChangeOfBasisMatrix;
6619     /* extra space for debugging */
6620     PetscScalar  *dbg_work = NULL;
6621 
6622     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6623     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6624     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6625     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6626     /* nonzeros for local mat */
6627     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6628     if (!pcbddc->benign_change || pcbddc->fake_change) {
6629       for (i=0;i<pcis->n;i++) nnz[i]=1;
6630     } else {
6631       const PetscInt *ii;
6632       PetscInt       n;
6633       PetscBool      flg_row;
6634       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6635       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6636       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6637     }
6638     for (i=n_vertices;i<total_counts_cc;i++) {
6639       if (PetscBTLookup(change_basis,i)) {
6640         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6641         if (PetscBTLookup(qr_needed_idx,i)) {
6642           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6643         } else {
6644           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6645           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6646         }
6647       }
6648     }
6649     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6650     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6651     ierr = PetscFree(nnz);CHKERRQ(ierr);
6652     /* Set interior change in the matrix */
6653     if (!pcbddc->benign_change || pcbddc->fake_change) {
6654       for (i=0;i<pcis->n;i++) {
6655         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6656       }
6657     } else {
6658       const PetscInt *ii,*jj;
6659       PetscScalar    *aa;
6660       PetscInt       n;
6661       PetscBool      flg_row;
6662       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6663       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6664       for (i=0;i<n;i++) {
6665         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6666       }
6667       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6668       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6669     }
6670 
6671     if (pcbddc->dbg_flag) {
6672       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6673       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6674     }
6675 
6676 
6677     /* Now we loop on the constraints which need a change of basis */
6678     /*
6679        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6680        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6681 
6682        Basic blocks of change of basis matrix T computed by
6683 
6684           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6685 
6686             | 1        0   ...        0         s_1/S |
6687             | 0        1   ...        0         s_2/S |
6688             |              ...                        |
6689             | 0        ...            1     s_{n-1}/S |
6690             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6691 
6692             with S = \sum_{i=1}^n s_i^2
6693             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6694                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6695 
6696           - QR decomposition of constraints otherwise
6697     */
6698     if (qr_needed && max_size_of_constraint) {
6699       /* space to store Q */
6700       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6701       /* array to store scaling factors for reflectors */
6702       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6703       /* first we issue queries for optimal work */
6704       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6705       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6706       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6707       lqr_work = -1;
6708       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6709       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6710       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6711       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6712       lgqr_work = -1;
6713       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6714       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6715       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6716       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6717       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6718 #if defined(PETSC_MISSING_LAPACK_ORGQR)
6719       SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"ORGQR - Lapack routine is unavailable.");
6720 #else
6721       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6722       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6723 #endif
6724       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6725       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6726       /* array to store rhs and solution of triangular solver */
6727       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6728       /* allocating workspace for check */
6729       if (pcbddc->dbg_flag) {
6730         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6731       }
6732     }
6733     /* array to store whether a node is primal or not */
6734     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6735     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6736     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6737     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);
6738     for (i=0;i<total_primal_vertices;i++) {
6739       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6740     }
6741     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6742 
6743     /* loop on constraints and see whether or not they need a change of basis and compute it */
6744     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6745       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6746       if (PetscBTLookup(change_basis,total_counts)) {
6747         /* get constraint info */
6748         primal_dofs = constraints_n[total_counts];
6749         dual_dofs = size_of_constraint-primal_dofs;
6750 
6751         if (pcbddc->dbg_flag) {
6752           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);
6753         }
6754 
6755         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6756 
6757           /* copy quadrature constraints for change of basis check */
6758           if (pcbddc->dbg_flag) {
6759             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6760           }
6761           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6762           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6763 
6764           /* compute QR decomposition of constraints */
6765           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6766           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6767           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6768           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6769           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6770           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6771           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6772 
6773           /* explictly compute R^-T */
6774           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6775           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6776           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6777           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6778           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6779           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6780           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6781 #if defined(PETSC_MISSING_LAPACK_TRTRS)
6782           SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"TRTRS - Lapack routine is unavailable.");
6783 #else
6784           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6785           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6786 #endif
6787           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6788 
6789           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6790           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6791           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6792           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6793           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6794           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6795 #if defined(PETSC_MISSING_LAPACK_ORGQR)
6796           SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"ORGQR - Lapack routine is unavailable.");
6797 #else
6798           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6799           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6800 #endif
6801           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6802 
6803           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6804              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6805              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6806           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6807           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6808           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6809           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6810           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6811           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6812           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6813           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));
6814           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6815           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6816 
6817           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6818           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6819           /* insert cols for primal dofs */
6820           for (j=0;j<primal_dofs;j++) {
6821             start_vals = &qr_basis[j*size_of_constraint];
6822             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6823             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6824           }
6825           /* insert cols for dual dofs */
6826           for (j=0,k=0;j<dual_dofs;k++) {
6827             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6828               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6829               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6830               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6831               j++;
6832             }
6833           }
6834 
6835           /* check change of basis */
6836           if (pcbddc->dbg_flag) {
6837             PetscInt   ii,jj;
6838             PetscBool valid_qr=PETSC_TRUE;
6839             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6840             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6841             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6842             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6843             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6844             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6845             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6846             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));
6847             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6848             for (jj=0;jj<size_of_constraint;jj++) {
6849               for (ii=0;ii<primal_dofs;ii++) {
6850                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6851                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6852               }
6853             }
6854             if (!valid_qr) {
6855               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6856               for (jj=0;jj<size_of_constraint;jj++) {
6857                 for (ii=0;ii<primal_dofs;ii++) {
6858                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6859                     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);
6860                   }
6861                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6862                     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);
6863                   }
6864                 }
6865               }
6866             } else {
6867               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6868             }
6869           }
6870         } else { /* simple transformation block */
6871           PetscInt    row,col;
6872           PetscScalar val,norm;
6873 
6874           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6875           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6876           for (j=0;j<size_of_constraint;j++) {
6877             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6878             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6879             if (!PetscBTLookup(is_primal,row_B)) {
6880               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6881               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6882               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6883             } else {
6884               for (k=0;k<size_of_constraint;k++) {
6885                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6886                 if (row != col) {
6887                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6888                 } else {
6889                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6890                 }
6891                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6892               }
6893             }
6894           }
6895           if (pcbddc->dbg_flag) {
6896             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6897           }
6898         }
6899       } else {
6900         if (pcbddc->dbg_flag) {
6901           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6902         }
6903       }
6904     }
6905 
6906     /* free workspace */
6907     if (qr_needed) {
6908       if (pcbddc->dbg_flag) {
6909         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6910       }
6911       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6912       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6913       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6914       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6915       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6916     }
6917     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6918     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6919     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6920 
6921     /* assembling of global change of variable */
6922     if (!pcbddc->fake_change) {
6923       Mat      tmat;
6924       PetscInt bs;
6925 
6926       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6927       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6928       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6929       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6930       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6931       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6932       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6933       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6934       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6935       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6936       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6937       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6938       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6939       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6940       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6941       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6942       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6943       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6944       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6945       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6946 
6947       /* check */
6948       if (pcbddc->dbg_flag) {
6949         PetscReal error;
6950         Vec       x,x_change;
6951 
6952         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6953         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6954         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6955         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6956         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6957         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6958         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6959         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6960         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6961         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6962         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6963         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6964         if (error > PETSC_SMALL) {
6965           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6966         }
6967         ierr = VecDestroy(&x);CHKERRQ(ierr);
6968         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6969       }
6970       /* adapt sub_schurs computed (if any) */
6971       if (pcbddc->use_deluxe_scaling) {
6972         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6973 
6974         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");
6975         if (sub_schurs && sub_schurs->S_Ej_all) {
6976           Mat                    S_new,tmat;
6977           IS                     is_all_N,is_V_Sall = NULL;
6978 
6979           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6980           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6981           if (pcbddc->deluxe_zerorows) {
6982             ISLocalToGlobalMapping NtoSall;
6983             IS                     is_V;
6984             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6985             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6986             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6987             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6988             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6989           }
6990           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6991           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6992           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6993           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6994           if (pcbddc->deluxe_zerorows) {
6995             const PetscScalar *array;
6996             const PetscInt    *idxs_V,*idxs_all;
6997             PetscInt          i,n_V;
6998 
6999             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7000             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
7001             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7002             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7003             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
7004             for (i=0;i<n_V;i++) {
7005               PetscScalar val;
7006               PetscInt    idx;
7007 
7008               idx = idxs_V[i];
7009               val = array[idxs_all[idxs_V[i]]];
7010               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
7011             }
7012             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7013             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7014             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
7015             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7016             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7017           }
7018           sub_schurs->S_Ej_all = S_new;
7019           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7020           if (sub_schurs->sum_S_Ej_all) {
7021             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7022             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
7023             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7024             if (pcbddc->deluxe_zerorows) {
7025               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7026             }
7027             sub_schurs->sum_S_Ej_all = S_new;
7028             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7029           }
7030           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
7031           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
7032         }
7033         /* destroy any change of basis context in sub_schurs */
7034         if (sub_schurs && sub_schurs->change) {
7035           PetscInt i;
7036 
7037           for (i=0;i<sub_schurs->n_subs;i++) {
7038             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
7039           }
7040           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
7041         }
7042       }
7043       if (pcbddc->switch_static) { /* need to save the local change */
7044         pcbddc->switch_static_change = localChangeOfBasisMatrix;
7045       } else {
7046         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
7047       }
7048       /* determine if any process has changed the pressures locally */
7049       pcbddc->change_interior = pcbddc->benign_have_null;
7050     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7051       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7052       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7053       pcbddc->use_qr_single = qr_needed;
7054     }
7055   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7056     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7057       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7058       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7059     } else {
7060       Mat benign_global = NULL;
7061       if (pcbddc->benign_have_null) {
7062         Mat M;
7063 
7064         pcbddc->change_interior = PETSC_TRUE;
7065         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7066         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7067         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7068         if (pcbddc->benign_change) {
7069           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7070           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7071         } else {
7072           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7073           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7074         }
7075         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7076         ierr = MatDestroy(&M);CHKERRQ(ierr);
7077         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7078         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7079       }
7080       if (pcbddc->user_ChangeOfBasisMatrix) {
7081         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7082         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7083       } else if (pcbddc->benign_have_null) {
7084         pcbddc->ChangeOfBasisMatrix = benign_global;
7085       }
7086     }
7087     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7088       IS             is_global;
7089       const PetscInt *gidxs;
7090 
7091       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7092       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7093       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7094       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7095       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7096     }
7097   }
7098   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7099     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7100   }
7101 
7102   if (!pcbddc->fake_change) {
7103     /* add pressure dofs to set of primal nodes for numbering purposes */
7104     for (i=0;i<pcbddc->benign_n;i++) {
7105       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7106       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7107       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7108       pcbddc->local_primal_size_cc++;
7109       pcbddc->local_primal_size++;
7110     }
7111 
7112     /* check if a new primal space has been introduced (also take into account benign trick) */
7113     pcbddc->new_primal_space_local = PETSC_TRUE;
7114     if (olocal_primal_size == pcbddc->local_primal_size) {
7115       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7116       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7117       if (!pcbddc->new_primal_space_local) {
7118         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7119         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7120       }
7121     }
7122     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7123     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7124   }
7125   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7126 
7127   /* flush dbg viewer */
7128   if (pcbddc->dbg_flag) {
7129     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7130   }
7131 
7132   /* free workspace */
7133   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7134   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7135   if (!pcbddc->adaptive_selection) {
7136     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7137     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7138   } else {
7139     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7140                       pcbddc->adaptive_constraints_idxs_ptr,
7141                       pcbddc->adaptive_constraints_data_ptr,
7142                       pcbddc->adaptive_constraints_idxs,
7143                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7144     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7145     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7146   }
7147   PetscFunctionReturn(0);
7148 }
7149 
7150 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7151 {
7152   ISLocalToGlobalMapping map;
7153   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7154   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7155   PetscInt               i,N;
7156   PetscBool              rcsr = PETSC_FALSE;
7157   PetscErrorCode         ierr;
7158 
7159   PetscFunctionBegin;
7160   if (pcbddc->recompute_topography) {
7161     pcbddc->graphanalyzed = PETSC_FALSE;
7162     /* Reset previously computed graph */
7163     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7164     /* Init local Graph struct */
7165     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7166     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7167     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7168 
7169     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7170       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7171     }
7172     /* Check validity of the csr graph passed in by the user */
7173     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);
7174 
7175     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7176     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7177       PetscInt  *xadj,*adjncy;
7178       PetscInt  nvtxs;
7179       PetscBool flg_row=PETSC_FALSE;
7180 
7181       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7182       if (flg_row) {
7183         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7184         pcbddc->computed_rowadj = PETSC_TRUE;
7185       }
7186       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7187       rcsr = PETSC_TRUE;
7188     }
7189     if (pcbddc->dbg_flag) {
7190       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7191     }
7192 
7193     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7194       PetscReal    *lcoords;
7195       PetscInt     n;
7196       MPI_Datatype dimrealtype;
7197 
7198       /* TODO: support for blocked */
7199       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);
7200       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7201       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7202       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7203       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7204       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7205       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7206       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7207       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7208 
7209       pcbddc->mat_graph->coords = lcoords;
7210       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7211       pcbddc->mat_graph->cnloc  = n;
7212     }
7213     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);
7214     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7215 
7216     /* Setup of Graph */
7217     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7218     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7219 
7220     /* attach info on disconnected subdomains if present */
7221     if (pcbddc->n_local_subs) {
7222       PetscInt *local_subs,n,totn;
7223 
7224       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7225       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7226       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7227       for (i=0;i<pcbddc->n_local_subs;i++) {
7228         const PetscInt *idxs;
7229         PetscInt       nl,j;
7230 
7231         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7232         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7233         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7234         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7235       }
7236       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7237       pcbddc->mat_graph->n_local_subs = totn + 1;
7238       pcbddc->mat_graph->local_subs = local_subs;
7239     }
7240   }
7241 
7242   if (!pcbddc->graphanalyzed) {
7243     /* Graph's connected components analysis */
7244     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7245     pcbddc->graphanalyzed = PETSC_TRUE;
7246     pcbddc->corner_selected = pcbddc->corner_selection;
7247   }
7248   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7249   PetscFunctionReturn(0);
7250 }
7251 
7252 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7253 {
7254   PetscInt       i,j,n;
7255   PetscScalar    *alphas;
7256   PetscReal      norm,*onorms;
7257   PetscErrorCode ierr;
7258 
7259   PetscFunctionBegin;
7260   n = *nio;
7261   if (!n) PetscFunctionReturn(0);
7262   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7263   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7264   if (norm < PETSC_SMALL) {
7265     onorms[0] = 0.0;
7266     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7267   } else {
7268     onorms[0] = norm;
7269   }
7270 
7271   for (i=1;i<n;i++) {
7272     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7273     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7274     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7275     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7276     if (norm < PETSC_SMALL) {
7277       onorms[i] = 0.0;
7278       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7279     } else {
7280       onorms[i] = norm;
7281     }
7282   }
7283   /* push nonzero vectors at the beginning */
7284   for (i=0;i<n;i++) {
7285     if (onorms[i] == 0.0) {
7286       for (j=i+1;j<n;j++) {
7287         if (onorms[j] != 0.0) {
7288           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7289           onorms[j] = 0.0;
7290         }
7291       }
7292     }
7293   }
7294   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7295   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7296   PetscFunctionReturn(0);
7297 }
7298 
7299 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7300 {
7301   Mat            A;
7302   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7303   PetscMPIInt    size,rank,color;
7304   PetscInt       *xadj,*adjncy;
7305   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7306   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7307   PetscInt       void_procs,*procs_candidates = NULL;
7308   PetscInt       xadj_count,*count;
7309   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7310   PetscSubcomm   psubcomm;
7311   MPI_Comm       subcomm;
7312   PetscErrorCode ierr;
7313 
7314   PetscFunctionBegin;
7315   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7316   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7317   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);
7318   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7319   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7320   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7321 
7322   if (have_void) *have_void = PETSC_FALSE;
7323   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7324   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7325   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7326   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7327   im_active = !!n;
7328   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7329   void_procs = size - active_procs;
7330   /* get ranks of of non-active processes in mat communicator */
7331   if (void_procs) {
7332     PetscInt ncand;
7333 
7334     if (have_void) *have_void = PETSC_TRUE;
7335     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7336     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7337     for (i=0,ncand=0;i<size;i++) {
7338       if (!procs_candidates[i]) {
7339         procs_candidates[ncand++] = i;
7340       }
7341     }
7342     /* force n_subdomains to be not greater that the number of non-active processes */
7343     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7344   }
7345 
7346   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7347      number of subdomains requested 1 -> send to master or first candidate in voids  */
7348   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7349   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7350     PetscInt issize,isidx,dest;
7351     if (*n_subdomains == 1) dest = 0;
7352     else dest = rank;
7353     if (im_active) {
7354       issize = 1;
7355       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7356         isidx = procs_candidates[dest];
7357       } else {
7358         isidx = dest;
7359       }
7360     } else {
7361       issize = 0;
7362       isidx = -1;
7363     }
7364     if (*n_subdomains != 1) *n_subdomains = active_procs;
7365     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7366     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7367     PetscFunctionReturn(0);
7368   }
7369   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7370   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7371   threshold = PetscMax(threshold,2);
7372 
7373   /* Get info on mapping */
7374   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7375 
7376   /* build local CSR graph of subdomains' connectivity */
7377   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7378   xadj[0] = 0;
7379   xadj[1] = PetscMax(n_neighs-1,0);
7380   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7381   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7382   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7383   for (i=1;i<n_neighs;i++)
7384     for (j=0;j<n_shared[i];j++)
7385       count[shared[i][j]] += 1;
7386 
7387   xadj_count = 0;
7388   for (i=1;i<n_neighs;i++) {
7389     for (j=0;j<n_shared[i];j++) {
7390       if (count[shared[i][j]] < threshold) {
7391         adjncy[xadj_count] = neighs[i];
7392         adjncy_wgt[xadj_count] = n_shared[i];
7393         xadj_count++;
7394         break;
7395       }
7396     }
7397   }
7398   xadj[1] = xadj_count;
7399   ierr = PetscFree(count);CHKERRQ(ierr);
7400   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7401   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7402 
7403   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7404 
7405   /* Restrict work on active processes only */
7406   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7407   if (void_procs) {
7408     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7409     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7410     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7411     subcomm = PetscSubcommChild(psubcomm);
7412   } else {
7413     psubcomm = NULL;
7414     subcomm = PetscObjectComm((PetscObject)mat);
7415   }
7416 
7417   v_wgt = NULL;
7418   if (!color) {
7419     ierr = PetscFree(xadj);CHKERRQ(ierr);
7420     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7421     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7422   } else {
7423     Mat             subdomain_adj;
7424     IS              new_ranks,new_ranks_contig;
7425     MatPartitioning partitioner;
7426     PetscInt        rstart=0,rend=0;
7427     PetscInt        *is_indices,*oldranks;
7428     PetscMPIInt     size;
7429     PetscBool       aggregate;
7430 
7431     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7432     if (void_procs) {
7433       PetscInt prank = rank;
7434       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7435       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7436       for (i=0;i<xadj[1];i++) {
7437         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7438       }
7439       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7440     } else {
7441       oldranks = NULL;
7442     }
7443     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7444     if (aggregate) { /* TODO: all this part could be made more efficient */
7445       PetscInt    lrows,row,ncols,*cols;
7446       PetscMPIInt nrank;
7447       PetscScalar *vals;
7448 
7449       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7450       lrows = 0;
7451       if (nrank<redprocs) {
7452         lrows = size/redprocs;
7453         if (nrank<size%redprocs) lrows++;
7454       }
7455       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7456       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7457       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7458       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7459       row = nrank;
7460       ncols = xadj[1]-xadj[0];
7461       cols = adjncy;
7462       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7463       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7464       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7465       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7466       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7467       ierr = PetscFree(xadj);CHKERRQ(ierr);
7468       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7469       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7470       ierr = PetscFree(vals);CHKERRQ(ierr);
7471       if (use_vwgt) {
7472         Vec               v;
7473         const PetscScalar *array;
7474         PetscInt          nl;
7475 
7476         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7477         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7478         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7479         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7480         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7481         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7482         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7483         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7484         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7485         ierr = VecDestroy(&v);CHKERRQ(ierr);
7486       }
7487     } else {
7488       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7489       if (use_vwgt) {
7490         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7491         v_wgt[0] = n;
7492       }
7493     }
7494     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7495 
7496     /* Partition */
7497     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7498 #if defined(PETSC_HAVE_PTSCOTCH)
7499     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7500 #elif defined(PETSC_HAVE_PARMETIS)
7501     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7502 #else
7503     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7504 #endif
7505     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7506     if (v_wgt) {
7507       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7508     }
7509     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7510     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7511     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7512     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7513     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7514 
7515     /* renumber new_ranks to avoid "holes" in new set of processors */
7516     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7517     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7518     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7519     if (!aggregate) {
7520       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7521 #if defined(PETSC_USE_DEBUG)
7522         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7523 #endif
7524         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7525       } else if (oldranks) {
7526         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7527       } else {
7528         ranks_send_to_idx[0] = is_indices[0];
7529       }
7530     } else {
7531       PetscInt    idx = 0;
7532       PetscMPIInt tag;
7533       MPI_Request *reqs;
7534 
7535       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7536       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7537       for (i=rstart;i<rend;i++) {
7538         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7539       }
7540       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7541       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7542       ierr = PetscFree(reqs);CHKERRQ(ierr);
7543       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7544 #if defined(PETSC_USE_DEBUG)
7545         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7546 #endif
7547         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7548       } else if (oldranks) {
7549         ranks_send_to_idx[0] = oldranks[idx];
7550       } else {
7551         ranks_send_to_idx[0] = idx;
7552       }
7553     }
7554     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7555     /* clean up */
7556     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7557     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7558     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7559     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7560   }
7561   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7562   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7563 
7564   /* assemble parallel IS for sends */
7565   i = 1;
7566   if (!color) i=0;
7567   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7568   PetscFunctionReturn(0);
7569 }
7570 
7571 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7572 
7573 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[])
7574 {
7575   Mat                    local_mat;
7576   IS                     is_sends_internal;
7577   PetscInt               rows,cols,new_local_rows;
7578   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7579   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7580   ISLocalToGlobalMapping l2gmap;
7581   PetscInt*              l2gmap_indices;
7582   const PetscInt*        is_indices;
7583   MatType                new_local_type;
7584   /* buffers */
7585   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7586   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7587   PetscInt               *recv_buffer_idxs_local;
7588   PetscScalar            *ptr_vals,*recv_buffer_vals;
7589   const PetscScalar      *send_buffer_vals;
7590   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7591   /* MPI */
7592   MPI_Comm               comm,comm_n;
7593   PetscSubcomm           subcomm;
7594   PetscMPIInt            n_sends,n_recvs,size;
7595   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7596   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7597   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7598   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7599   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7600   PetscErrorCode         ierr;
7601 
7602   PetscFunctionBegin;
7603   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7604   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7605   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);
7606   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7607   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7608   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7609   PetscValidLogicalCollectiveBool(mat,reuse,6);
7610   PetscValidLogicalCollectiveInt(mat,nis,8);
7611   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7612   if (nvecs) {
7613     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7614     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7615   }
7616   /* further checks */
7617   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7618   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7619   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7620   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7621   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7622   if (reuse && *mat_n) {
7623     PetscInt mrows,mcols,mnrows,mncols;
7624     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7625     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7626     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7627     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7628     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7629     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7630     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7631   }
7632   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7633   PetscValidLogicalCollectiveInt(mat,bs,0);
7634 
7635   /* prepare IS for sending if not provided */
7636   if (!is_sends) {
7637     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7638     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7639   } else {
7640     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7641     is_sends_internal = is_sends;
7642   }
7643 
7644   /* get comm */
7645   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7646 
7647   /* compute number of sends */
7648   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7649   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7650 
7651   /* compute number of receives */
7652   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7653   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7654   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7655   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7656   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7657   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7658   ierr = PetscFree(iflags);CHKERRQ(ierr);
7659 
7660   /* restrict comm if requested */
7661   subcomm = 0;
7662   destroy_mat = PETSC_FALSE;
7663   if (restrict_comm) {
7664     PetscMPIInt color,subcommsize;
7665 
7666     color = 0;
7667     if (restrict_full) {
7668       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7669     } else {
7670       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7671     }
7672     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7673     subcommsize = size - subcommsize;
7674     /* check if reuse has been requested */
7675     if (reuse) {
7676       if (*mat_n) {
7677         PetscMPIInt subcommsize2;
7678         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7679         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7680         comm_n = PetscObjectComm((PetscObject)*mat_n);
7681       } else {
7682         comm_n = PETSC_COMM_SELF;
7683       }
7684     } else { /* MAT_INITIAL_MATRIX */
7685       PetscMPIInt rank;
7686 
7687       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7688       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7689       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7690       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7691       comm_n = PetscSubcommChild(subcomm);
7692     }
7693     /* flag to destroy *mat_n if not significative */
7694     if (color) destroy_mat = PETSC_TRUE;
7695   } else {
7696     comm_n = comm;
7697   }
7698 
7699   /* prepare send/receive buffers */
7700   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7701   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7702   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7703   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7704   if (nis) {
7705     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7706   }
7707 
7708   /* Get data from local matrices */
7709   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7710     /* TODO: See below some guidelines on how to prepare the local buffers */
7711     /*
7712        send_buffer_vals should contain the raw values of the local matrix
7713        send_buffer_idxs should contain:
7714        - MatType_PRIVATE type
7715        - PetscInt        size_of_l2gmap
7716        - PetscInt        global_row_indices[size_of_l2gmap]
7717        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7718     */
7719   else {
7720     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7721     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7722     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7723     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7724     send_buffer_idxs[1] = i;
7725     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7726     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7727     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7728     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7729     for (i=0;i<n_sends;i++) {
7730       ilengths_vals[is_indices[i]] = len*len;
7731       ilengths_idxs[is_indices[i]] = len+2;
7732     }
7733   }
7734   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7735   /* additional is (if any) */
7736   if (nis) {
7737     PetscMPIInt psum;
7738     PetscInt j;
7739     for (j=0,psum=0;j<nis;j++) {
7740       PetscInt plen;
7741       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7742       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7743       psum += len+1; /* indices + lenght */
7744     }
7745     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7746     for (j=0,psum=0;j<nis;j++) {
7747       PetscInt plen;
7748       const PetscInt *is_array_idxs;
7749       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7750       send_buffer_idxs_is[psum] = plen;
7751       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7752       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7753       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7754       psum += plen+1; /* indices + lenght */
7755     }
7756     for (i=0;i<n_sends;i++) {
7757       ilengths_idxs_is[is_indices[i]] = psum;
7758     }
7759     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7760   }
7761   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7762 
7763   buf_size_idxs = 0;
7764   buf_size_vals = 0;
7765   buf_size_idxs_is = 0;
7766   buf_size_vecs = 0;
7767   for (i=0;i<n_recvs;i++) {
7768     buf_size_idxs += (PetscInt)olengths_idxs[i];
7769     buf_size_vals += (PetscInt)olengths_vals[i];
7770     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7771     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7772   }
7773   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7774   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7775   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7776   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7777 
7778   /* get new tags for clean communications */
7779   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7780   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7781   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7782   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7783 
7784   /* allocate for requests */
7785   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7786   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7787   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7788   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7789   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7790   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7791   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7792   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7793 
7794   /* communications */
7795   ptr_idxs = recv_buffer_idxs;
7796   ptr_vals = recv_buffer_vals;
7797   ptr_idxs_is = recv_buffer_idxs_is;
7798   ptr_vecs = recv_buffer_vecs;
7799   for (i=0;i<n_recvs;i++) {
7800     source_dest = onodes[i];
7801     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7802     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7803     ptr_idxs += olengths_idxs[i];
7804     ptr_vals += olengths_vals[i];
7805     if (nis) {
7806       source_dest = onodes_is[i];
7807       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);
7808       ptr_idxs_is += olengths_idxs_is[i];
7809     }
7810     if (nvecs) {
7811       source_dest = onodes[i];
7812       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7813       ptr_vecs += olengths_idxs[i]-2;
7814     }
7815   }
7816   for (i=0;i<n_sends;i++) {
7817     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7818     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7819     ierr = MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7820     if (nis) {
7821       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);
7822     }
7823     if (nvecs) {
7824       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7825       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7826     }
7827   }
7828   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7829   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7830 
7831   /* assemble new l2g map */
7832   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7833   ptr_idxs = recv_buffer_idxs;
7834   new_local_rows = 0;
7835   for (i=0;i<n_recvs;i++) {
7836     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7837     ptr_idxs += olengths_idxs[i];
7838   }
7839   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7840   ptr_idxs = recv_buffer_idxs;
7841   new_local_rows = 0;
7842   for (i=0;i<n_recvs;i++) {
7843     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7844     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7845     ptr_idxs += olengths_idxs[i];
7846   }
7847   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7848   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7849   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7850 
7851   /* infer new local matrix type from received local matrices type */
7852   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7853   /* 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) */
7854   if (n_recvs) {
7855     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7856     ptr_idxs = recv_buffer_idxs;
7857     for (i=0;i<n_recvs;i++) {
7858       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7859         new_local_type_private = MATAIJ_PRIVATE;
7860         break;
7861       }
7862       ptr_idxs += olengths_idxs[i];
7863     }
7864     switch (new_local_type_private) {
7865       case MATDENSE_PRIVATE:
7866         new_local_type = MATSEQAIJ;
7867         bs = 1;
7868         break;
7869       case MATAIJ_PRIVATE:
7870         new_local_type = MATSEQAIJ;
7871         bs = 1;
7872         break;
7873       case MATBAIJ_PRIVATE:
7874         new_local_type = MATSEQBAIJ;
7875         break;
7876       case MATSBAIJ_PRIVATE:
7877         new_local_type = MATSEQSBAIJ;
7878         break;
7879       default:
7880         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7881         break;
7882     }
7883   } else { /* by default, new_local_type is seqaij */
7884     new_local_type = MATSEQAIJ;
7885     bs = 1;
7886   }
7887 
7888   /* create MATIS object if needed */
7889   if (!reuse) {
7890     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7891     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7892   } else {
7893     /* it also destroys the local matrices */
7894     if (*mat_n) {
7895       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7896     } else { /* this is a fake object */
7897       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7898     }
7899   }
7900   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7901   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7902 
7903   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7904 
7905   /* Global to local map of received indices */
7906   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7907   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7908   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7909 
7910   /* restore attributes -> type of incoming data and its size */
7911   buf_size_idxs = 0;
7912   for (i=0;i<n_recvs;i++) {
7913     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7914     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7915     buf_size_idxs += (PetscInt)olengths_idxs[i];
7916   }
7917   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7918 
7919   /* set preallocation */
7920   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7921   if (!newisdense) {
7922     PetscInt *new_local_nnz=0;
7923 
7924     ptr_idxs = recv_buffer_idxs_local;
7925     if (n_recvs) {
7926       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7927     }
7928     for (i=0;i<n_recvs;i++) {
7929       PetscInt j;
7930       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7931         for (j=0;j<*(ptr_idxs+1);j++) {
7932           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7933         }
7934       } else {
7935         /* TODO */
7936       }
7937       ptr_idxs += olengths_idxs[i];
7938     }
7939     if (new_local_nnz) {
7940       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7941       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7942       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7943       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7944       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7945       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7946     } else {
7947       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7948     }
7949     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7950   } else {
7951     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7952   }
7953 
7954   /* set values */
7955   ptr_vals = recv_buffer_vals;
7956   ptr_idxs = recv_buffer_idxs_local;
7957   for (i=0;i<n_recvs;i++) {
7958     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7959       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7960       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7961       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7962       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7963       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7964     } else {
7965       /* TODO */
7966     }
7967     ptr_idxs += olengths_idxs[i];
7968     ptr_vals += olengths_vals[i];
7969   }
7970   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7971   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7972   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7973   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7974   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7975   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7976 
7977 #if 0
7978   if (!restrict_comm) { /* check */
7979     Vec       lvec,rvec;
7980     PetscReal infty_error;
7981 
7982     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7983     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7984     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7985     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7986     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7987     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7988     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7989     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7990     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7991   }
7992 #endif
7993 
7994   /* assemble new additional is (if any) */
7995   if (nis) {
7996     PetscInt **temp_idxs,*count_is,j,psum;
7997 
7998     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7999     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
8000     ptr_idxs = recv_buffer_idxs_is;
8001     psum = 0;
8002     for (i=0;i<n_recvs;i++) {
8003       for (j=0;j<nis;j++) {
8004         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8005         count_is[j] += plen; /* increment counting of buffer for j-th IS */
8006         psum += plen;
8007         ptr_idxs += plen+1; /* shift pointer to received data */
8008       }
8009     }
8010     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
8011     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
8012     for (i=1;i<nis;i++) {
8013       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
8014     }
8015     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
8016     ptr_idxs = recv_buffer_idxs_is;
8017     for (i=0;i<n_recvs;i++) {
8018       for (j=0;j<nis;j++) {
8019         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8020         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
8021         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
8022         ptr_idxs += plen+1; /* shift pointer to received data */
8023       }
8024     }
8025     for (i=0;i<nis;i++) {
8026       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8027       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);
8028       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8029     }
8030     ierr = PetscFree(count_is);CHKERRQ(ierr);
8031     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
8032     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
8033   }
8034   /* free workspace */
8035   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
8036   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8037   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
8038   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8039   if (isdense) {
8040     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
8041     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
8042     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
8043   } else {
8044     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
8045   }
8046   if (nis) {
8047     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8048     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
8049   }
8050 
8051   if (nvecs) {
8052     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8053     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8054     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8055     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8056     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
8057     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
8058     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
8059     /* set values */
8060     ptr_vals = recv_buffer_vecs;
8061     ptr_idxs = recv_buffer_idxs_local;
8062     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8063     for (i=0;i<n_recvs;i++) {
8064       PetscInt j;
8065       for (j=0;j<*(ptr_idxs+1);j++) {
8066         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8067       }
8068       ptr_idxs += olengths_idxs[i];
8069       ptr_vals += olengths_idxs[i]-2;
8070     }
8071     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8072     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
8073     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
8074   }
8075 
8076   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
8077   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
8078   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
8079   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
8080   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
8081   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8082   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8083   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8084   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8085   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8086   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8087   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8088   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8089   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8090   ierr = PetscFree(onodes);CHKERRQ(ierr);
8091   if (nis) {
8092     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8093     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8094     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8095   }
8096   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8097   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8098     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8099     for (i=0;i<nis;i++) {
8100       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8101     }
8102     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8103       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8104     }
8105     *mat_n = NULL;
8106   }
8107   PetscFunctionReturn(0);
8108 }
8109 
8110 /* temporary hack into ksp private data structure */
8111 #include <petsc/private/kspimpl.h>
8112 
8113 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8114 {
8115   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8116   PC_IS                  *pcis = (PC_IS*)pc->data;
8117   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8118   Mat                    coarsedivudotp = NULL;
8119   Mat                    coarseG,t_coarse_mat_is;
8120   MatNullSpace           CoarseNullSpace = NULL;
8121   ISLocalToGlobalMapping coarse_islg;
8122   IS                     coarse_is,*isarray,corners;
8123   PetscInt               i,im_active=-1,active_procs=-1;
8124   PetscInt               nis,nisdofs,nisneu,nisvert;
8125   PetscInt               coarse_eqs_per_proc;
8126   PC                     pc_temp;
8127   PCType                 coarse_pc_type;
8128   KSPType                coarse_ksp_type;
8129   PetscBool              multilevel_requested,multilevel_allowed;
8130   PetscBool              coarse_reuse;
8131   PetscInt               ncoarse,nedcfield;
8132   PetscBool              compute_vecs = PETSC_FALSE;
8133   PetscScalar            *array;
8134   MatReuse               coarse_mat_reuse;
8135   PetscBool              restr, full_restr, have_void;
8136   PetscMPIInt            size;
8137   PetscErrorCode         ierr;
8138 
8139   PetscFunctionBegin;
8140   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8141   /* Assign global numbering to coarse dofs */
8142   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 */
8143     PetscInt ocoarse_size;
8144     compute_vecs = PETSC_TRUE;
8145 
8146     pcbddc->new_primal_space = PETSC_TRUE;
8147     ocoarse_size = pcbddc->coarse_size;
8148     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8149     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8150     /* see if we can avoid some work */
8151     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8152       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8153       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8154         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8155         coarse_reuse = PETSC_FALSE;
8156       } else { /* we can safely reuse already computed coarse matrix */
8157         coarse_reuse = PETSC_TRUE;
8158       }
8159     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8160       coarse_reuse = PETSC_FALSE;
8161     }
8162     /* reset any subassembling information */
8163     if (!coarse_reuse || pcbddc->recompute_topography) {
8164       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8165     }
8166   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8167     coarse_reuse = PETSC_TRUE;
8168   }
8169   if (coarse_reuse && pcbddc->coarse_ksp) {
8170     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8171     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8172     coarse_mat_reuse = MAT_REUSE_MATRIX;
8173   } else {
8174     coarse_mat = NULL;
8175     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8176   }
8177 
8178   /* creates temporary l2gmap and IS for coarse indexes */
8179   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8180   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8181 
8182   /* creates temporary MATIS object for coarse matrix */
8183   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8184   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);
8185   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8186   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8187   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8188   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8189 
8190   /* count "active" (i.e. with positive local size) and "void" processes */
8191   im_active = !!(pcis->n);
8192   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8193 
8194   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8195   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8196   /* full_restr : just use the receivers from the subassembling pattern */
8197   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8198   coarse_mat_is        = NULL;
8199   multilevel_allowed   = PETSC_FALSE;
8200   multilevel_requested = PETSC_FALSE;
8201   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8202   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8203   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8204   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8205   if (multilevel_requested) {
8206     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8207     restr      = PETSC_FALSE;
8208     full_restr = PETSC_FALSE;
8209   } else {
8210     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8211     restr      = PETSC_TRUE;
8212     full_restr = PETSC_TRUE;
8213   }
8214   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8215   ncoarse = PetscMax(1,ncoarse);
8216   if (!pcbddc->coarse_subassembling) {
8217     if (pcbddc->coarsening_ratio > 1) {
8218       if (multilevel_requested) {
8219         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8220       } else {
8221         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8222       }
8223     } else {
8224       PetscMPIInt rank;
8225 
8226       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8227       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8228       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8229     }
8230   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8231     PetscInt    psum;
8232     if (pcbddc->coarse_ksp) psum = 1;
8233     else psum = 0;
8234     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8235     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8236   }
8237   /* determine if we can go multilevel */
8238   if (multilevel_requested) {
8239     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8240     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8241   }
8242   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8243 
8244   /* dump subassembling pattern */
8245   if (pcbddc->dbg_flag && multilevel_allowed) {
8246     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8247   }
8248   /* compute dofs splitting and neumann boundaries for coarse dofs */
8249   nedcfield = -1;
8250   corners = NULL;
8251   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8252     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8253     const PetscInt         *idxs;
8254     ISLocalToGlobalMapping tmap;
8255 
8256     /* create map between primal indices (in local representative ordering) and local primal numbering */
8257     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8258     /* allocate space for temporary storage */
8259     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8260     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8261     /* allocate for IS array */
8262     nisdofs = pcbddc->n_ISForDofsLocal;
8263     if (pcbddc->nedclocal) {
8264       if (pcbddc->nedfield > -1) {
8265         nedcfield = pcbddc->nedfield;
8266       } else {
8267         nedcfield = 0;
8268         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8269         nisdofs = 1;
8270       }
8271     }
8272     nisneu = !!pcbddc->NeumannBoundariesLocal;
8273     nisvert = 0; /* nisvert is not used */
8274     nis = nisdofs + nisneu + nisvert;
8275     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8276     /* dofs splitting */
8277     for (i=0;i<nisdofs;i++) {
8278       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8279       if (nedcfield != i) {
8280         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8281         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8282         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8283         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8284       } else {
8285         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8286         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8287         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8288         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8289         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8290       }
8291       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8292       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8293       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8294     }
8295     /* neumann boundaries */
8296     if (pcbddc->NeumannBoundariesLocal) {
8297       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8298       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8299       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8300       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8301       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8302       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8303       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8304       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8305     }
8306     /* coordinates */
8307     if (pcbddc->corner_selected) {
8308       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8309       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8310       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8311       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8312       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8313       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8314       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8315       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8316       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8317     }
8318     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8319     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8320     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8321   } else {
8322     nis = 0;
8323     nisdofs = 0;
8324     nisneu = 0;
8325     nisvert = 0;
8326     isarray = NULL;
8327   }
8328   /* destroy no longer needed map */
8329   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8330 
8331   /* subassemble */
8332   if (multilevel_allowed) {
8333     Vec       vp[1];
8334     PetscInt  nvecs = 0;
8335     PetscBool reuse,reuser;
8336 
8337     if (coarse_mat) reuse = PETSC_TRUE;
8338     else reuse = PETSC_FALSE;
8339     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8340     vp[0] = NULL;
8341     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8342       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8343       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8344       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8345       nvecs = 1;
8346 
8347       if (pcbddc->divudotp) {
8348         Mat      B,loc_divudotp;
8349         Vec      v,p;
8350         IS       dummy;
8351         PetscInt np;
8352 
8353         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8354         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8355         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8356         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8357         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8358         ierr = VecSet(p,1.);CHKERRQ(ierr);
8359         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8360         ierr = VecDestroy(&p);CHKERRQ(ierr);
8361         ierr = MatDestroy(&B);CHKERRQ(ierr);
8362         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8363         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8364         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8365         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8366         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8367         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8368         ierr = VecDestroy(&v);CHKERRQ(ierr);
8369       }
8370     }
8371     if (reuser) {
8372       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8373     } else {
8374       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8375     }
8376     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8377       PetscScalar       *arraym;
8378       const PetscScalar *arrayv;
8379       PetscInt          nl;
8380       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8381       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8382       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8383       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8384       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8385       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8386       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8387       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8388     } else {
8389       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8390     }
8391   } else {
8392     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8393   }
8394   if (coarse_mat_is || coarse_mat) {
8395     if (!multilevel_allowed) {
8396       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8397     } else {
8398       /* if this matrix is present, it means we are not reusing the coarse matrix */
8399       if (coarse_mat_is) {
8400         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8401         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8402         coarse_mat = coarse_mat_is;
8403       }
8404     }
8405   }
8406   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8407   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8408 
8409   /* create local to global scatters for coarse problem */
8410   if (compute_vecs) {
8411     PetscInt lrows;
8412     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8413     if (coarse_mat) {
8414       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8415     } else {
8416       lrows = 0;
8417     }
8418     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8419     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8420     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8421     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8422     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8423   }
8424   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8425 
8426   /* set defaults for coarse KSP and PC */
8427   if (multilevel_allowed) {
8428     coarse_ksp_type = KSPRICHARDSON;
8429     coarse_pc_type  = PCBDDC;
8430   } else {
8431     coarse_ksp_type = KSPPREONLY;
8432     coarse_pc_type  = PCREDUNDANT;
8433   }
8434 
8435   /* print some info if requested */
8436   if (pcbddc->dbg_flag) {
8437     if (!multilevel_allowed) {
8438       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8439       if (multilevel_requested) {
8440         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);
8441       } else if (pcbddc->max_levels) {
8442         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8443       }
8444       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8445     }
8446   }
8447 
8448   /* communicate coarse discrete gradient */
8449   coarseG = NULL;
8450   if (pcbddc->nedcG && multilevel_allowed) {
8451     MPI_Comm ccomm;
8452     if (coarse_mat) {
8453       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8454     } else {
8455       ccomm = MPI_COMM_NULL;
8456     }
8457     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8458   }
8459 
8460   /* create the coarse KSP object only once with defaults */
8461   if (coarse_mat) {
8462     PetscBool   isredundant,isbddc,force,valid;
8463     PetscViewer dbg_viewer = NULL;
8464 
8465     if (pcbddc->dbg_flag) {
8466       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8467       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8468     }
8469     if (!pcbddc->coarse_ksp) {
8470       char   prefix[256],str_level[16];
8471       size_t len;
8472 
8473       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8474       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8475       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8476       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8477       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8478       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8479       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8480       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8481       /* TODO is this logic correct? should check for coarse_mat type */
8482       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8483       /* prefix */
8484       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8485       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8486       if (!pcbddc->current_level) {
8487         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8488         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8489       } else {
8490         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8491         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8492         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8493         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8494         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8495         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8496         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8497       }
8498       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8499       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8500       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8501       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8502       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8503       /* allow user customization */
8504       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8505       /* get some info after set from options */
8506       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8507       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8508       force = PETSC_FALSE;
8509       ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8510       ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8511       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8512       if (multilevel_allowed && !force && !valid) {
8513         isbddc = PETSC_TRUE;
8514         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8515         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8516         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8517         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8518         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8519           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8520           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8521           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8522           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8523           pc_temp->setfromoptionscalled++;
8524         }
8525       }
8526     }
8527     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8528     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8529     if (nisdofs) {
8530       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8531       for (i=0;i<nisdofs;i++) {
8532         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8533       }
8534     }
8535     if (nisneu) {
8536       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8537       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8538     }
8539     if (nisvert) {
8540       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8541       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8542     }
8543     if (coarseG) {
8544       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8545     }
8546 
8547     /* get some info after set from options */
8548     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8549 
8550     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8551     if (isbddc && !multilevel_allowed) {
8552       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8553     }
8554     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8555     force = PETSC_FALSE;
8556     ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8557     ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8558     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8559       ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8560     }
8561     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8562     if (isredundant) {
8563       KSP inner_ksp;
8564       PC  inner_pc;
8565 
8566       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8567       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8568     }
8569 
8570     /* parameters which miss an API */
8571     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8572     if (isbddc) {
8573       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8574 
8575       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8576       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8577       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8578       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8579       if (pcbddc_coarse->benign_saddle_point) {
8580         Mat                    coarsedivudotp_is;
8581         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8582         IS                     row,col;
8583         const PetscInt         *gidxs;
8584         PetscInt               n,st,M,N;
8585 
8586         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8587         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8588         st   = st-n;
8589         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8590         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8591         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8592         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8593         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8594         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8595         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8596         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8597         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8598         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8599         ierr = ISDestroy(&row);CHKERRQ(ierr);
8600         ierr = ISDestroy(&col);CHKERRQ(ierr);
8601         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8602         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8603         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8604         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8605         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8606         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8607         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8608         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8609         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8610         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8611         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8612         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8613       }
8614     }
8615 
8616     /* propagate symmetry info of coarse matrix */
8617     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8618     if (pc->pmat->symmetric_set) {
8619       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8620     }
8621     if (pc->pmat->hermitian_set) {
8622       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8623     }
8624     if (pc->pmat->spd_set) {
8625       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8626     }
8627     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8628       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8629     }
8630     /* set operators */
8631     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8632     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8633     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8634     if (pcbddc->dbg_flag) {
8635       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8636     }
8637   }
8638   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8639   ierr = PetscFree(isarray);CHKERRQ(ierr);
8640 #if 0
8641   {
8642     PetscViewer viewer;
8643     char filename[256];
8644     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8645     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8646     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8647     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8648     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8649     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8650   }
8651 #endif
8652 
8653   if (corners) {
8654     Vec            gv;
8655     IS             is;
8656     const PetscInt *idxs;
8657     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8658     PetscScalar    *coords;
8659 
8660     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8661     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8662     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8663     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8664     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8665     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8666     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8667     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8668     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8669 
8670     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8671     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8672     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8673     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8674     for (i=0;i<n;i++) {
8675       for (d=0;d<cdim;d++) {
8676         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8677       }
8678     }
8679     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8680     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8681 
8682     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8683     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8684     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8685     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8686     ierr = PetscFree(coords);CHKERRQ(ierr);
8687     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8688     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8689     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8690     if (pcbddc->coarse_ksp) {
8691       PC        coarse_pc;
8692       PetscBool isbddc;
8693 
8694       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8695       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8696       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8697         PetscReal *realcoords;
8698 
8699         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8700 #if defined(PETSC_USE_COMPLEX)
8701         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8702         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8703 #else
8704         realcoords = coords;
8705 #endif
8706         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8707 #if defined(PETSC_USE_COMPLEX)
8708         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8709 #endif
8710       }
8711     }
8712     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8713     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8714   }
8715   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8716 
8717   if (pcbddc->coarse_ksp) {
8718     Vec crhs,csol;
8719 
8720     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8721     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8722     if (!csol) {
8723       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8724     }
8725     if (!crhs) {
8726       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8727     }
8728   }
8729   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8730 
8731   /* compute null space for coarse solver if the benign trick has been requested */
8732   if (pcbddc->benign_null) {
8733 
8734     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8735     for (i=0;i<pcbddc->benign_n;i++) {
8736       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8737     }
8738     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8739     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8740     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8741     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8742     if (coarse_mat) {
8743       Vec         nullv;
8744       PetscScalar *array,*array2;
8745       PetscInt    nl;
8746 
8747       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8748       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8749       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8750       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8751       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8752       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8753       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8754       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8755       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8756       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8757     }
8758   }
8759   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8760 
8761   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8762   if (pcbddc->coarse_ksp) {
8763     PetscBool ispreonly;
8764 
8765     if (CoarseNullSpace) {
8766       PetscBool isnull;
8767       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8768       if (isnull) {
8769         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8770       }
8771       /* TODO: add local nullspaces (if any) */
8772     }
8773     /* setup coarse ksp */
8774     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8775     /* Check coarse problem if in debug mode or if solving with an iterative method */
8776     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8777     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8778       KSP       check_ksp;
8779       KSPType   check_ksp_type;
8780       PC        check_pc;
8781       Vec       check_vec,coarse_vec;
8782       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8783       PetscInt  its;
8784       PetscBool compute_eigs;
8785       PetscReal *eigs_r,*eigs_c;
8786       PetscInt  neigs;
8787       const char *prefix;
8788 
8789       /* Create ksp object suitable for estimation of extreme eigenvalues */
8790       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8791       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8792       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8793       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8794       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8795       /* prevent from setup unneeded object */
8796       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8797       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8798       if (ispreonly) {
8799         check_ksp_type = KSPPREONLY;
8800         compute_eigs = PETSC_FALSE;
8801       } else {
8802         check_ksp_type = KSPGMRES;
8803         compute_eigs = PETSC_TRUE;
8804       }
8805       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8806       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8807       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8808       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8809       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8810       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8811       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8812       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8813       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8814       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8815       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8816       /* create random vec */
8817       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8818       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8819       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8820       /* solve coarse problem */
8821       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8822       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8823       /* set eigenvalue estimation if preonly has not been requested */
8824       if (compute_eigs) {
8825         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8826         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8827         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8828         if (neigs) {
8829           lambda_max = eigs_r[neigs-1];
8830           lambda_min = eigs_r[0];
8831           if (pcbddc->use_coarse_estimates) {
8832             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8833               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8834               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8835             }
8836           }
8837         }
8838       }
8839 
8840       /* check coarse problem residual error */
8841       if (pcbddc->dbg_flag) {
8842         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8843         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8844         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8845         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8846         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8847         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8848         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8849         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8850         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8851         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8852         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8853         if (CoarseNullSpace) {
8854           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8855         }
8856         if (compute_eigs) {
8857           PetscReal          lambda_max_s,lambda_min_s;
8858           KSPConvergedReason reason;
8859           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8860           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8861           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8862           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8863           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);
8864           for (i=0;i<neigs;i++) {
8865             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8866           }
8867         }
8868         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8869         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8870       }
8871       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8872       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8873       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8874       if (compute_eigs) {
8875         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8876         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8877       }
8878     }
8879   }
8880   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8881   /* print additional info */
8882   if (pcbddc->dbg_flag) {
8883     /* waits until all processes reaches this point */
8884     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8885     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8886     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8887   }
8888 
8889   /* free memory */
8890   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8891   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8892   PetscFunctionReturn(0);
8893 }
8894 
8895 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8896 {
8897   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8898   PC_IS*         pcis = (PC_IS*)pc->data;
8899   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8900   IS             subset,subset_mult,subset_n;
8901   PetscInt       local_size,coarse_size=0;
8902   PetscInt       *local_primal_indices=NULL;
8903   const PetscInt *t_local_primal_indices;
8904   PetscErrorCode ierr;
8905 
8906   PetscFunctionBegin;
8907   /* Compute global number of coarse dofs */
8908   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8909   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8910   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8911   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8912   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8913   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8914   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8915   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8916   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8917   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);
8918   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8919   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8920   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8921   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8922   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8923 
8924   /* check numbering */
8925   if (pcbddc->dbg_flag) {
8926     PetscScalar coarsesum,*array,*array2;
8927     PetscInt    i;
8928     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8929 
8930     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8931     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8932     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8933     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8934     /* counter */
8935     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8936     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8937     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8938     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8939     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8940     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8941     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8942     for (i=0;i<pcbddc->local_primal_size;i++) {
8943       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8944     }
8945     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8946     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8947     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8948     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8949     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8950     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8951     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8952     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8953     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8954     for (i=0;i<pcis->n;i++) {
8955       if (array[i] != 0.0 && array[i] != array2[i]) {
8956         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8957         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8958         set_error = PETSC_TRUE;
8959         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8960         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);
8961       }
8962     }
8963     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8964     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8965     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8966     for (i=0;i<pcis->n;i++) {
8967       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8968     }
8969     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8970     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8971     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8972     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8973     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8974     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8975     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8976       PetscInt *gidxs;
8977 
8978       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8979       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8980       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8981       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8982       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8983       for (i=0;i<pcbddc->local_primal_size;i++) {
8984         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);
8985       }
8986       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8987       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8988     }
8989     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8990     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8991     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8992   }
8993 
8994   /* get back data */
8995   *coarse_size_n = coarse_size;
8996   *local_primal_indices_n = local_primal_indices;
8997   PetscFunctionReturn(0);
8998 }
8999 
9000 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
9001 {
9002   IS             localis_t;
9003   PetscInt       i,lsize,*idxs,n;
9004   PetscScalar    *vals;
9005   PetscErrorCode ierr;
9006 
9007   PetscFunctionBegin;
9008   /* get indices in local ordering exploiting local to global map */
9009   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
9010   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
9011   for (i=0;i<lsize;i++) vals[i] = 1.0;
9012   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9013   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
9014   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
9015   if (idxs) { /* multilevel guard */
9016     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
9017     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
9018   }
9019   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
9020   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9021   ierr = PetscFree(vals);CHKERRQ(ierr);
9022   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
9023   /* now compute set in local ordering */
9024   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9025   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9026   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9027   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
9028   for (i=0,lsize=0;i<n;i++) {
9029     if (PetscRealPart(vals[i]) > 0.5) {
9030       lsize++;
9031     }
9032   }
9033   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
9034   for (i=0,lsize=0;i<n;i++) {
9035     if (PetscRealPart(vals[i]) > 0.5) {
9036       idxs[lsize++] = i;
9037     }
9038   }
9039   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9040   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
9041   *localis = localis_t;
9042   PetscFunctionReturn(0);
9043 }
9044 
9045 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
9046 {
9047   PC_IS               *pcis=(PC_IS*)pc->data;
9048   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9049   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9050   Mat                 S_j;
9051   PetscInt            *used_xadj,*used_adjncy;
9052   PetscBool           free_used_adj;
9053   PetscErrorCode      ierr;
9054 
9055   PetscFunctionBegin;
9056   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9057   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9058   free_used_adj = PETSC_FALSE;
9059   if (pcbddc->sub_schurs_layers == -1) {
9060     used_xadj = NULL;
9061     used_adjncy = NULL;
9062   } else {
9063     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9064       used_xadj = pcbddc->mat_graph->xadj;
9065       used_adjncy = pcbddc->mat_graph->adjncy;
9066     } else if (pcbddc->computed_rowadj) {
9067       used_xadj = pcbddc->mat_graph->xadj;
9068       used_adjncy = pcbddc->mat_graph->adjncy;
9069     } else {
9070       PetscBool      flg_row=PETSC_FALSE;
9071       const PetscInt *xadj,*adjncy;
9072       PetscInt       nvtxs;
9073 
9074       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9075       if (flg_row) {
9076         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
9077         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
9078         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
9079         free_used_adj = PETSC_TRUE;
9080       } else {
9081         pcbddc->sub_schurs_layers = -1;
9082         used_xadj = NULL;
9083         used_adjncy = NULL;
9084       }
9085       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9086     }
9087   }
9088 
9089   /* setup sub_schurs data */
9090   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9091   if (!sub_schurs->schur_explicit) {
9092     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9093     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9094     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);
9095   } else {
9096     Mat       change = NULL;
9097     Vec       scaling = NULL;
9098     IS        change_primal = NULL, iP;
9099     PetscInt  benign_n;
9100     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9101     PetscBool need_change = PETSC_FALSE;
9102     PetscBool discrete_harmonic = PETSC_FALSE;
9103 
9104     if (!pcbddc->use_vertices && reuse_solvers) {
9105       PetscInt n_vertices;
9106 
9107       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9108       reuse_solvers = (PetscBool)!n_vertices;
9109     }
9110     if (!pcbddc->benign_change_explicit) {
9111       benign_n = pcbddc->benign_n;
9112     } else {
9113       benign_n = 0;
9114     }
9115     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9116        We need a global reduction to avoid possible deadlocks.
9117        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9118     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9119       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9120       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9121       need_change = (PetscBool)(!need_change);
9122     }
9123     /* If the user defines additional constraints, we import them here.
9124        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 */
9125     if (need_change) {
9126       PC_IS   *pcisf;
9127       PC_BDDC *pcbddcf;
9128       PC      pcf;
9129 
9130       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9131       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9132       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9133       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9134 
9135       /* hacks */
9136       pcisf                        = (PC_IS*)pcf->data;
9137       pcisf->is_B_local            = pcis->is_B_local;
9138       pcisf->vec1_N                = pcis->vec1_N;
9139       pcisf->BtoNmap               = pcis->BtoNmap;
9140       pcisf->n                     = pcis->n;
9141       pcisf->n_B                   = pcis->n_B;
9142       pcbddcf                      = (PC_BDDC*)pcf->data;
9143       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9144       pcbddcf->mat_graph           = pcbddc->mat_graph;
9145       pcbddcf->use_faces           = PETSC_TRUE;
9146       pcbddcf->use_change_of_basis = PETSC_TRUE;
9147       pcbddcf->use_change_on_faces = PETSC_TRUE;
9148       pcbddcf->use_qr_single       = PETSC_TRUE;
9149       pcbddcf->fake_change         = PETSC_TRUE;
9150 
9151       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9152       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9153       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9154       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9155       change = pcbddcf->ConstraintMatrix;
9156       pcbddcf->ConstraintMatrix = NULL;
9157 
9158       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9159       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9160       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9161       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9162       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9163       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9164       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9165       pcf->ops->destroy = NULL;
9166       pcf->ops->reset   = NULL;
9167       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9168     }
9169     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9170 
9171     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9172     if (iP) {
9173       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9174       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9175       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9176     }
9177     if (discrete_harmonic) {
9178       Mat A;
9179       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9180       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9181       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9182       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);
9183       ierr = MatDestroy(&A);CHKERRQ(ierr);
9184     } else {
9185       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);
9186     }
9187     ierr = MatDestroy(&change);CHKERRQ(ierr);
9188     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9189   }
9190   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9191 
9192   /* free adjacency */
9193   if (free_used_adj) {
9194     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9195   }
9196   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9197   PetscFunctionReturn(0);
9198 }
9199 
9200 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9201 {
9202   PC_IS               *pcis=(PC_IS*)pc->data;
9203   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9204   PCBDDCGraph         graph;
9205   PetscErrorCode      ierr;
9206 
9207   PetscFunctionBegin;
9208   /* attach interface graph for determining subsets */
9209   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9210     IS       verticesIS,verticescomm;
9211     PetscInt vsize,*idxs;
9212 
9213     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9214     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9215     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9216     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9217     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9218     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9219     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9220     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9221     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9222     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9223     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9224   } else {
9225     graph = pcbddc->mat_graph;
9226   }
9227   /* print some info */
9228   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9229     IS       vertices;
9230     PetscInt nv,nedges,nfaces;
9231     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9232     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9233     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9234     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9235     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9236     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9237     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9238     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9239     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9240     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9241     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9242   }
9243 
9244   /* sub_schurs init */
9245   if (!pcbddc->sub_schurs) {
9246     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9247   }
9248   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);
9249 
9250   /* free graph struct */
9251   if (pcbddc->sub_schurs_rebuild) {
9252     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9253   }
9254   PetscFunctionReturn(0);
9255 }
9256 
9257 PetscErrorCode PCBDDCCheckOperator(PC pc)
9258 {
9259   PC_IS               *pcis=(PC_IS*)pc->data;
9260   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9261   PetscErrorCode      ierr;
9262 
9263   PetscFunctionBegin;
9264   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9265     IS             zerodiag = NULL;
9266     Mat            S_j,B0_B=NULL;
9267     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9268     PetscScalar    *p0_check,*array,*array2;
9269     PetscReal      norm;
9270     PetscInt       i;
9271 
9272     /* B0 and B0_B */
9273     if (zerodiag) {
9274       IS       dummy;
9275 
9276       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9277       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9278       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9279       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9280     }
9281     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9282     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9283     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9284     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9285     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9286     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9287     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9288     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9289     /* S_j */
9290     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9291     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9292 
9293     /* mimic vector in \widetilde{W}_\Gamma */
9294     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9295     /* continuous in primal space */
9296     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9297     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9298     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9299     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9300     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9301     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9302     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9303     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9304     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9305     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9306     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9307     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9308     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9309     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9310 
9311     /* assemble rhs for coarse problem */
9312     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9313     /* local with Schur */
9314     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9315     if (zerodiag) {
9316       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9317       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9318       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9319       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9320     }
9321     /* sum on primal nodes the local contributions */
9322     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9323     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9324     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9325     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9326     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9327     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9328     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9329     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9330     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9331     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9332     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9333     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9334     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9335     /* scale primal nodes (BDDC sums contibutions) */
9336     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9337     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9338     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9339     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9340     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9341     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9342     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9343     /* global: \widetilde{B0}_B w_\Gamma */
9344     if (zerodiag) {
9345       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9346       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9347       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9348       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9349     }
9350     /* BDDC */
9351     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9352     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9353 
9354     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9355     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9356     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9357     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9358     for (i=0;i<pcbddc->benign_n;i++) {
9359       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);
9360     }
9361     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9362     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9363     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9364     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9365     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9366     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9367   }
9368   PetscFunctionReturn(0);
9369 }
9370 
9371 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9372 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9373 {
9374   Mat            At;
9375   IS             rows;
9376   PetscInt       rst,ren;
9377   PetscErrorCode ierr;
9378   PetscLayout    rmap;
9379 
9380   PetscFunctionBegin;
9381   rst = ren = 0;
9382   if (ccomm != MPI_COMM_NULL) {
9383     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9384     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9385     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9386     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9387     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9388   }
9389   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9390   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9391   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9392 
9393   if (ccomm != MPI_COMM_NULL) {
9394     Mat_MPIAIJ *a,*b;
9395     IS         from,to;
9396     Vec        gvec;
9397     PetscInt   lsize;
9398 
9399     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9400     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9401     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9402     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9403     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9404     a    = (Mat_MPIAIJ*)At->data;
9405     b    = (Mat_MPIAIJ*)(*B)->data;
9406     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9407     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9408     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9409     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9410     b->A = a->A;
9411     b->B = a->B;
9412 
9413     b->donotstash      = a->donotstash;
9414     b->roworiented     = a->roworiented;
9415     b->rowindices      = 0;
9416     b->rowvalues       = 0;
9417     b->getrowactive    = PETSC_FALSE;
9418 
9419     (*B)->rmap         = rmap;
9420     (*B)->factortype   = A->factortype;
9421     (*B)->assembled    = PETSC_TRUE;
9422     (*B)->insertmode   = NOT_SET_VALUES;
9423     (*B)->preallocated = PETSC_TRUE;
9424 
9425     if (a->colmap) {
9426 #if defined(PETSC_USE_CTABLE)
9427       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9428 #else
9429       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9430       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9431       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9432 #endif
9433     } else b->colmap = 0;
9434     if (a->garray) {
9435       PetscInt len;
9436       len  = a->B->cmap->n;
9437       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9438       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9439       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9440     } else b->garray = 0;
9441 
9442     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9443     b->lvec = a->lvec;
9444     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9445 
9446     /* cannot use VecScatterCopy */
9447     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9448     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9449     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9450     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9451     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9452     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9453     ierr = ISDestroy(&from);CHKERRQ(ierr);
9454     ierr = ISDestroy(&to);CHKERRQ(ierr);
9455     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9456   }
9457   ierr = MatDestroy(&At);CHKERRQ(ierr);
9458   PetscFunctionReturn(0);
9459 }
9460